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ABSTRACT 


This  report  describes  a  matrix  bandwidth 
reduction  preprocessor  for  use  with  the  NASA 
structural  analysis  computer  program,  NASTRAN. 
Called  BANDIT,  the  program  is  written  in 
FORTRAN  and  uses  the  Cuthill-McKee  strategy  for 
resequencing  grid  points.  Versions  of  the  program 
for  both  CDC  and  other  computers  are  presented. 


ADMINISTRATIVE  INFORMATION 

The  work  reported  herein  was  carried  out  under  Task 
Area  ZR  014  02  01. 
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I.  INTRODUCTION 


The  NASA  structural  analysis  computer  program,  NASTRAN,  is 
a  large  general  purpose  program  gaming  wide  acceptance  in  the  Navy 
for  the  solution  of  both  static  and  dynamic  structural  problems. 

Since  NASTRAN  uses  the  finite  element  displacement  method, 

the  structural  matrices  which  are  formed  are  symmetric  and  sparse. 

With  a  suitable  choice  of  the  numbers  (labels)  assigned  to  the  grid  points, 

the  matrices  are  also  banded  (i„  e. ,  the  non-zero  entries  in  each  matrix 

are  clustered  about  the  main  diagonal).  For  this  reason,  many  of  the 

routines  used  by  NASTRAN  for  the  solution  of  linear  equations  and  for 

the  extraction  of  eigenvalues  operate  most  efficiently  when  the  band- 

widths  of  the  structural  matrices  are  minimum.  Indeed,  the  number  of 
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calculations  required  in  such  routines  is  0(n  b  ),  where  n  is  the 
matrix  order  and  b  is  the  matrix  bandwidth. 

Although  it  is  essential  to  the  NASTRAN  user  to  have  matrices  with 
small  bandwidth,  NASTRAN  currently  places  the  burden  on  the  user  to 
number  his  structure  so  as  to  provide  such  a  bandwidth.  The  inherent 
difficulties  in  sequencing  nodal  labels  manually  and  the  increasing  use 
of  automatic  data  generators  make  this  an  excessive  and  unnecessary 
burden  for  most  structural  analysts. 

NASTRAN  currently  allows  the  user  to  include  in  his  input  data  deck 
a  set  of  cards  referred  to  as  SEQGP  cards.  These  cards  define  a 
look-up  table  giving  the  correspondence  between  the  original  grid  numbers 
used  in  defining  the  problem  and  a  new  set  of  numbers  to  be  used 
internally  for  all  calculations. 
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This  report  describes  a  FORTRAN  computer  program  called 

BANDIT  which  can  be  used  as  a  preprocessor  to  the  NASTRAN  program 

to  automatically  resequence  the  grid  point  numbers  for  reduced  bandwidth. 

Using  a  standard  NASTRAN  data  deck  as  input,  BANDIT  resequences  the 

numbering  for  reduced  bandwidth,  if  possible,  and  generates  a  set  of 

SEQGP  punch  cards  for  insertion  into  the  NASTRAN  deck. 

The  renumbering  strategy  used  in  BANDIT  is  that  developed  by 

Cuthill  and  McKee\  The  need  to  resort  to  "strategies"  becomes  evident 

when  one  considers  that  n  grid  points  (or  nodes)^  can  be  sequenced  in  n! 

distinct  ways.  Thus,  with  any  strategy,  there  is  no  guarantee  that  an 

optimum  numbering  (i,  e. ,  one  yielding  minimum  bandwidth)  will  be 
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achieved.  However,  of  several  strategies  tested  to  date,  the  Cuthill- 
McKee  approach*  appears  to  be  the  most  consistent  for  the  reduction 
of  matrix  bandwidth  for  the  classes  of  structures  of  prime  interest  to  the 
Navy, 

The  computer  program  described  herein  was  developed  primarily 
for  use  on  CDC  6400/6600  computers  and  hence  has  some  machine- 
dependent  features.  However,  for  use  on  other  computers,  a  machine- 
independent  (and  slightly  less  versatile)  version  of  BANDIT  is  also 
described. 


1  Cuthill,  E,H,  and  J,  M.  McKee,  "Reducing  the  Bandwidth  of  Sparse 
Symmetric  Matrices,  "  Proceedings  of  the  24th  National  Conference 
ACM  1969,  pp.  157-172. 

2  Throughout  this  report,  "grid  point"  and  "node"  are  used  interchangeably. 

3  "Sparse*  Mqtrlcdfe' -and  Their  Applications ,:6\;Editpd;by  T>.  J >■.  SRo'seiSiid 

R .  A. j3V illoughby ,  Plenum  Press,  NSW  York. (1972), .  ’'Several  Strategies  for 
F educing  the  (Bandwidth  of  Matrices)  ",  (E.H.  Cuthill),  pp,  157-166, 
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II.  USE  OF  THE  BANDIT  PROGRAM 


Throughout  this  and  subsequent  sections,  it  is  assumed  that  the 
reader  is  familiar  with  the  use  of  the  NASTRAN  structural  analysis 
computer  program^. 

BANDIT's  primary  reason  for  existence  is  the  generation  of  the 
NASTRAN  SEQGP  data  cards  to  effect  low  matrix  bandwidth.  As  a 
by-product,  BANDIT  can  also  be  used  to  right-adjust  the  NASTRAN  bulk 
data.  In  either  case,  following  the  execution  of  BANDIT,  the  complete 
right-adjusted  data  deck  is  available  on  disk  file.  In  addition,  the  user 
can  elect  to  have  punch  card  output  for  either  the  entire  deck  or  the 
SEQGP  cards  alone. 

The  input  data  deck  for  BANDIT  consists  of  a  standard  NASTRAN 
data  deck  (ID  card  through  ENDDATA  card,  inclusive)  with  the  addition 
of  appropriate  BANDIT  option  cards  somewhere  before  the  BEGIN  BULK 
card.  These  cards,  called  $ -option  cards,  indicate  to  BANDIT  the 
user’s  choice  of  options,  i.e. ,  what  the  user  wants  BANDIT  to  do.  The 
$ -option  cards  are  listed  and  described  in  detail  in  the  next  section. 

On  CDC  machines,  BANDIT  functions  as  a  variable-core  program. 
Hence  it  is  essentially  open-ended  with  respect  to  the  number  of  grid 
points  that  can  be  handled.  During  execution,  the  system  is  interrogated 
to  determine  the  field  length  (amount  of  core).  The  dimensions  of  key 
arrays  are  then  set  so  as  to  fill  the  available  core.  As  a  result, 

BANDIT  must  be  executed  on  CDC  machines  with  "NOREDUCE.  "  in  effect 
in  order  to  prevent  the  automatic  reduction  of  field  length  after  the  program 
is  loaded. 


4  "The  NASTRAN  User's  Manual,  "  edited  by  C.W.  McCormick, 
NASA  SP-222,  September  1970. 
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BANDIT  will  load  and  execute  in  less  than  50000g  Words  of 
core.  With  this  field  length,  typical  structures  with  less  than  500  grid 
points  can  be  handled.  For  larger  structures,  more  core  may  be 
needed,  in  which  case  BANDIT  so  informs  the  user.  It  has  been  our 
experience,  however,  that  rarely  are  more  than  60000g  words  needed. 

A  more  detailed  discussion  of  core  requirements  appears  in  Section  V. 

Although  BANDIT  will  accept  an  entire  NASTRAN  deck  as  input, 
resequencing  requires  only  the  following  NASTRAN  cards:  BEGIN  BULK, 
ENDDATA,  and  all  ’’connection”  cards.  In  particular,  GRID  cards  are 
not  used  by  BANDIT.  The  current  list  of  connection  cards  which 
BANDIT  recognizes  is  given  in  Table  1. 

BANDIT  will  accept  data  on  either  short  or  long  field  data  cards. 

The  only  restriction  to  the  data  concerns  sorting.  Since  BANDIT  does 
not  sort  the  bulk  data  deck,  each  continuation  to  a  connection  card 
must  immediately  follow  the  parent  card.  Normally,  however,  unless 
long  field  cards  are  being  used,  each  logical  connection  card  consists 
of  only  one  physical  card. 

If  the  user  so  indicates,  BANDIT  will  process  all  multi-point 
constraint  (MPC)  cards  present.  While  NASTRAN  MPC’s  refer  to 
individual  degrees  of  freedom,  BANDIT  considers  only  grid  points.  Thus, 
each  dependent  point  appearing  in  an  MPC  relation  is  eliminated  from 
the  connection  table.  Additional  connections  are  also  generated  between 
each  independent  point  in  the  constraint  equation  and  every  other  point 
to  which  the  dependent  point  was  previously  connected. 


5  The  subscript  ”8”  in  this  context  means  "base  8”. 
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TABLE  1  -  CONNECTION  CARDS  RECOGNIZED  BY  BANDIT 


CBAR 

CIS2D4 

CQUAD2 

CCONEAX 

CIS2D8 

CQUAD3 

CDAMP1 

CIS3D8 

CROD 

CDAMP2 

CIS3D20 

C  SHEAR 

CDAMP3 

CISH8 

CTETRA 

C  DAMP  4 

CISH16 

CTORDRG 

CELASl 

CMASSl 

CTRAPRG 

CELAS2 

CMASS2 

CTRBSC 

CELAS3 

CMASS3 

CTRIA1 

CELAS4 

CMASS4 

CTRIA2 

CFLUID2 

CONMl 

CTRIARG 

CFLUID3 

CONM2 

CTRMEM 

CFLUID4 

CONROD 

CTRPLT 

CHEXAl 

CQDMEM 

CTUBE 

CHEXA2 

CQDPLT 

C  TWIST 

CHTTRI2 

CQUADl 

CVISC 
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It  should  be  emphasized  that  only  in  rare  eases  would  it  make 
sense  to  let  BANDIT  process  MPC’s.  The  main  reasons  for  this  are 
that  BANDIT  does  not  consider  individual  degrees  of  freedom  and,  in 
addition,  cannot  distinguish  one  MPC  ’’set”  from  another.  Moreover, 
the  effects  of  MPC’s  might  be  better  handled  by  NASTRAN’s  active 
column  feature. 

The  whole  question  of  NASTRAN  active  columns  complicates  the 
bandwidth  reduction  problem,  since  there  are  clearly  cases  in  which 
certain  grid  points  should  be  relegated  to  active  columns.  An  example 
might  be  the  grid  points  common  to  both  the  fuselage  and  a  wing  on  an 
airplane.  If  the  user  is  able  to  identify  such  points,  he  can  indicate 
them  to  BANDIT  using  the  $IGNORE  card  described  in  the  next  section. 
This  BANDIT  feature,  like  the  MPC  feature,  will  probably  find  only 
occasional  use. 

Following  the  successful  completion  of  a  BANDIT  run,  whether 
resequencing  was  performed  or  not,  the  entire  NASTRAN  deck  is 
contained  on  a  file  called  TAPE8  (logical  unit  8  on  some  machines).  If 
resequencing  has  been  performed,  this  file  includes  the  SEQGP  cards 
generated.  These  cards  are  inserted  into  the  bulk  data  deck  before  the 
first  card  whose  mnemonic  would  alphabetically  follow  "SEQGP”.  Thus, 
for  a  NASTRAN  deck  already  properly  sorted,  the  block  of  SEQGP 
cards  will  be  inserted  into  its  proper  place.  On  machines  such  as  the 
IBM  360,  whose  collating  sequencers  opposite  to  that  on  the  CDC  6400, 
modification  of  the  coding  is  needed  for  proper  placement. 
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III.  THE  $ -OPTION  CARDS 


The  input  data  deck  for  BANDIT  consists  of  a  standard  NASTRAN 
data  deck  (ID  card  through  ENDDATA  card,  inclusive)  with  the  addition 
of  appropriate  BANDIT  option  cards  somewhere  before  the  BEGIN  BULK 
card.  These  option  cards  take  the  form  of  NASTRAN  comment  cards, 

L  e. ,  a  card  with  a  dollar  sign  ($)  in  card  column  #1. 

The  BANDIT  $-option  cards  may  appear  in  any  order  and  any 
location  as  long  as  they  precede  the  BEGIN  BULK  card.  There  are  two 
general  formats  for  these  cards, 

$KEYWORDl  KEYWORD2 
or 

$KEYWORDl  Nl  N2  N3  ...  , 

where  the  Ni's  are  positive  integers  separated  by  one  or  more  blanks. 

In  order  to  qualify  as  a  NASTRAN  comment  card,  the  $  must  appear  in 
card  column  #1. 

Additional  restrictions  on  the  $ -option  cards  are  as  follows: 

(1)  KEYWORDl  must  start  in  card  column  #2. 

(2)  There  may  be  no  imbedded  blanks  in  either  keyword. 

(3)  Keywords  (or  integers)  must  be  separated  by  one  or 
more  blanks. 

(4)  At  least  the  first  two  letters  of  each  keyword  are  required 
for  proper  identification. 

A  complete  list  of  the  $ -option  cards,  along  with  a  summary  of 
the  use  of  each  card,  appears  in  Table  2.  In  the  absence  of  any  card 
listed,  the  underlined  option  is  chosen  by  default. 
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TABLE  2  -  SUMMARY  OF  BANDIT  $ -OPTION  CARDS 

(Underline  denotes  default;  only  the  first  two  letters  of  each  keyword 
are  required) 


$  SEQUENCE 

NO 

YES 

$RIGHTADJUST 

NO 

YES 

$  PUNCH 

NONE 

SEQGP 

ALL 

$GRID 

Nl 

$  PRINT 

MIN 

MAX 

$MPC 

NO 

YES 

$IGNORE 

Nl  N2  N 

Resequencing  not  desired 

Resequencing  is  desired 

No  right-adjusting  desired 

Bulk  data  is  to  be  right-adjusted 

No  punch  output  desired 

Only  SEQGP  cards  are  to  be  punched 

The  entire  NASTRAN  deck  is  to 
be  punched 

The  integer  Nl  is  an  upper  bound 
on  the  number  of  grid  points. 

(The  default  limits  the  maximum 
nodal  degree  to  approximately 
19.) 

Basic  printed  output 

Extensive  printed  output 

MPC  cards  are  not  to  be  processed 

MPC  cards  are  to  be  processed 

.  Grid  numbers  Ni  appearing  here 
are  ignored  during  resequencing 
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The  $SEQUENCE  card  is  required  to  resequence  the  grid  point 
labels  and  generate  the  SEQGP  cards.  For  resequencing  purposes,  the 
only  other  data  cards  required  are  BEGIN  BULK,  ENDDATA,  and  all 
connection  cards. 

The  right-adjusting  of  the  bulk  data  is  performed  automatically  if 
resequencing  ($SEQUENCE  YES)  is  elected.  The  user  can  then  elect  to 
have  this  deck  punched  by  using  $PUNCH  ALL.  In  any  case,  it  can  be 
accessed  on  TAPE8. 

The  standard  printed  output  consists  of  a  title  page,  a  listing  of  the 
SEQGP  cards  generated  (if  resequencing  is  requested),  and  a  user 
summary.  Use  of  the  $PRINT  MAX  card  results  in  the  printing  of 
additional  tables  as  well  as  information  on  the  flow  of  calculations  during 
the  actual  resequencing.  However,  because  of  the  additional  work 
involved  in  generating  several  of  the  tables,  the  user  pays  a  penalty  in 
the  form  of  increased  execution  time.  A  detailed  explanation  of  BANDIT 
output  appears  in  the  next  section. 

Use  of  the  $MPC  YES  card  results  in  the  processing  of  all  MPC 
cards  in  the  NASTRAN  deck,  regardless  of  their  identifying  set  numbers. 
During  processing,  all  dependent  grid  points  on  all  MPC  cards  will  be 
eliminated  from  the  connection  table  after  the  additional  connections  due 
to  the  constraint  relations  are  accounted  for.  For  this  reason,  the  user 
would  normally  decline  to  use  this  feature. 

Although  BANDIT  is  a  variable -core  program,  the  specific  way  in 
which  the  available  core  is  partitioned  depends  on  both  the  number  of 
grid  points  and  the  maximum  nodal  degree.  Nodal  degree  is  defined  in 
Section  IV.  B.  Based  on  the  space  available,  BANDIT  computes  default 
values  for  the  dimensions  of  various  arrays.  This  partitioning  can  be 
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optimized  for  larger  problems  by  declaring  to  BANDIT  the  number  of 
grid  points  present.  The  appropriate  $-option  card  is  $GRID  Nl.  Here, 
Nl  is  an  upper  bound  (preferably  least  upper  bound)  on  the  number  of 
grid  points.  In  the  absence  of  this  card,  the  default  values  computed  by 
BANDIT  result  in  a  limit  of  approximately  19  on  the  maximum  nodal 
degree. 

The  $IGNORE  card  (Table  2)  can  be  used  to  designate  those  grid 
points  Ni  which  should  be  ignored  completely  by  BANDIT  during 
resequencing.  This  normally  results  (in  NASTRAN)  in  those  points  being 
placed  into  active  columns.  Any  number  of  $IGNORE  cards  may  appear, 
although  the  total  number  of  ignored  points  may  not  exceed  100.  Ignored 
points  are  renumbered  last  by  the  SEQGP  cards. 


IV.  PRINTED  OUTPUT 


A.  DESCRIPTION 

There  are  two  levels  of  BANDIT  printed  output:  maximum  printing 
(obtained  by  using  the  $PRINT  MAX  card),  or  minimum  printing 
(obtained  by  default  or  by  using  $PRINT  MIN).  The  latter  is  a  subset  of 
the  former. 

If  resequencing  is  elected,  the  basic  (minimum)  output  consists  of 
a  listing  of  the  SEQGP  cards  generated  and  a  user  summary.  The  user 
summary  contains  the  following  information: 

(1)  original  matrix  semi -bandwidth 

(2)  new  matrix  semi -bandwidth 

(3)  central  processor  (CP)  time  in  BANDIT,  in  seconds 
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(4)  original  matrix  profile 

(5)  new  matrix  profile 

(6)  number  of  grid  points 

(7)  number  of  elements 

(8)  number  of  components 

(9)  maximum  nodal  degree 

(10)  number  of  points  of  zero  degree 

(11)  punch  output  requested 

(12)  field  length  (FL),  octal 

(13)  the  FORTRAN  variables  MAXGRD,  MAXDEG,  &  KORE 

(defined  below) 

(14)  date  and  time 

In  the  "machine -independent”  version  of  BANDIT  (Appendix  B),  items  3 
and  14  and  KORE  are  omitted,  since  the  determination  of  these  quantities 
involves  machine-dependent  coding. 

B.  DEFINITIONS 

6 

For  a  matrix  A,  we  follow  the  notation  of  Cuthill  and  define  0.  as 
the  difference  between  i  and  the  column  index  of  the  first  non-zero 
element  of  row  i  of  A.  Then  the  semi -bandwidth  B  is  given  by 

B  =  m  ax  »  (1) 

1 

This  value  is  listed  in  1  and  2  above.  We  note  that  the  relationship 
between  B  and  the  "NASTRAN  bandwidth"  B^  is 

BN  =  (B+l)k,  (2) 


6  Cuthill,  E.C.,  op.  cit. 
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where  k  is  the  average  number  of  degrees-of-freedom  per  grid  point. 
This  formula  assumes  zero  NASTRAN  active  columns. 

The  profile  P  of  the  matrix  A  is  defined  as 

N 

P  =  E  0.  (3) 

i=l  1 

where  N  is  the  matrix  order.  These  values  are  listed  in  4  and  5  of  the 
user  summary.  They  provide  some  measure  of  the  space  which  would  be 
required  to  store  the  matrix  A  if  profile  storage  were  employed  instead 
of  band  storage.  Since  NASTRAN  does  make  use  of  active  columns  in 
its  routines,  the  matrix  profile  may  be  of  interest  to  some  users. 

The  number  of  grid  points  counted  by  BANDIT  (and  listed  in  the 
user  summary)  includes  only  those  points  appearing  on  recognizable 
elements  (Table  1).  The  NASTRAN  GRID  cards  are  not  processed. 

The  number  of  components  of  a  structure  is  the  number  of  independent 
substructures,  each  of  which  has  no  connections  with  grid  points  of  any 
other  substructure.  In  the  event  MPC’s  are  processed,  each  dependent 
point  is  eliminated  from  the  connection  table  and  hence  becomes  its  own 
component. 

The  degree  of  a  grid  point  (node)  is  defined  as  the  number  of  other 
grid  points  to  which  it  is  connected.  The  user  summary  lists  both  the 
maximum  nodal  degree  and  the  number  of  grid  points  of  zero  degree. 

The  variables  MAXGRD  and  MAXDEG  are  the  upper  bounds  on  the 
number  of  grid  points  and  maximum  nodal  degree,  respectively,  for  a 
given  BANDIT  run.  The  variable  KORE  (given  in  both  octal  and  decimal) 
refers  to  the  length  of  blank  common  in  words.  It  is  included  in  the 
summary  to  aid  the  user  in  determining  his  core  requirements  for  very 
large  structures.  (See  Section  V. ) 
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If  the  user  elects  maximum  printing,  the  printed  output  also 
includes  an  internal/external  grid  point  correspondence  table,  three 
connection  tables,  and  a  set  of  informational  messages  concerning  the 
renumbering  strategy. 

The  correspondence  table  lists,  for  each  internal  number,  the 
original  grid  number  to  which  it  corresponds.  These  internal  numbers 
are  simply  the  integers  1  to  N  for  a  structure  containing  N  grid  points. 

The  three  connection  tables  supply  connectivity  information  in 
terms  of  internal  numbers,  original  grid  point  numbers,  and  renumbered 
numbers  (new  numbers  assigned  by  the  SEQGP  cards).  For  each  node 
label  i,  the  connection  table  lists  its  component  index,  the  "distance” 
from  the  first  non-zero  entry  in  row  i  (of  the  matrix)  to  the  diagonal  (0.), 
the  degree  of  node  i,  and  the  labels  of  the  adjacent  nodes. 


V.  CORE  REQUIREMENTS  ON  THE  CDC  COMPUTERS 

For  a  given  structure,  the  core  requirements  depend  on  two 
parameters:  the  number  of  grid  points  NN,  and  the  maximum  nodal 
degree  MM. 

It  is  not  intended  that  the  user  should  normally  have  to  calculate 
the  required  core  in  order  to  use  BANDIT.  A  field  length  of  about  55000 

8 

words  should  be  sufficient  for  most  structures.  However,  to  cover 
situations  in  which  either  NN  or  MM  is  unusually  large,  the  user  can 
estimate  his  core  requirements  using  the  algorithm  briefly  described 
here. 
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The  length  of  blank  common  storage  during  any  given  run  is 
denoted  KORE.  This  space  is  partitioned  among  several  arrays  whose 
dimensions  are  given :in  terms  of  the  variables  MAXGRD  and  MAXDEG, 
which  are  upper  bounds  on  NN  and  MM,  respectively.  The  approximate 
relationship  between  these  variables  is 


KORE  =  (MAXGRD/K+3) * MAXDEG +  8*MAXGRD  ,  (4) 


where  K,  the  number  of  integers  packed  per  word,  is  given  by 


MAXGRD  <510 
MAXGRD  >  2045 
otherwise. 


In  the  absence  of  a  $GRID  card  in  the  NASTRAN  deck,  BANDIT 
assigns  default  values  to  MAXGRD  and  MAXDEG  such  that  MAXDEG  is 
approximately  19.  Thus,  whenever  the  user  anticipates  a  maximum 
nodal  degree  MM  greater  than  19,  he  must  make  use  of  the  $GRID  card. 

Using  Equation  (4),  structures  for  which  KORE<  8500jq  can  be 
run  in  a  field  length  (FL)  of  55000g  words.  Thus,  for  larger  values  of 
KORE,  the  user  need  only  increase  the  FL  accordingly. 


VI.  THE  RENUMBERING  STRATEGY 

Although  most  of  the  FORTRAN  coding  in  BANDIT  is  devoted  to 
the  task  of  developing  the  connection  table,  the  heart  of  the  program  is 
the  strategy  used  for  renumbering.  BANDIT  uses  the  bandwidth-reduction 
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approach  developed  by  E.  H.  Cuthill  and  J.  M.  McKee  .  The  resequencing 
subroutines  were  written  during  their  early  research  in  this  area.  Here, 
for  completeness,  we  present  a  brief  summary  of  the  main  ideas  of  the 

strategy.  A  complete  discussion,  including  comparison  with  other  methods, 

7  8 

appears  in  the  Cuthill-McKee  paper.  A  recent  survey  article  by  Cuthill 

compares  algorithms  developed  for  reducing  matrix  bandwidth,  wavefront, 

or  profile.  Extensive  bibliographies  appear  in  both  these  papers  and 

hence  need  not  be  cited  here. 

For  the  purposes  of  this  discussion,  a  starting  node  (or  grid  point) 

7 

is  one  given  the  new  label  1.  The  Cuthill-McKee  method  is  direct 
rather  than  iterative.  It  involves  first  the  selection  of  one  or  more 
possible  starting  nodes.  Although  these  nodes  are  normally  of  low  degree, 
the  one  eventually  chosen  to  be  the  starting  node  need  not  be  of  minimum 
degree. 

For  each  possible  starting  node,  the  remaining  nodes  are  relabeled 
according  to  the  following  prescription:  The  nodes  adjacent  to  the 
starting  node  are  labeled  in  sequence  in  the  order  of  their  increasing 
degree.  In  the  terminology  of  graph  theory,  these  nodes  are  said  to 
be  at  the  first  level.  Next,  for  each  node  of  level  1  and  in  sequence, 
the  numbering  continues  with  those  nodes  as  yet  unnumbered  and 
adjacent,  in  the  order  of  their  increasing  degree.  The  set  of  all  nodes 
(other  than  1)  adjacent  to  level  1  nodes  thus  constitute  level  2.  The 
numbering  continues  in  this  fashion,  level-by-level,  until  all  nodes 
have  been  numbered.  If  several  nodes  could  receive  a  given  label,  the 
first  node  to  qualify  is  chosen. 


7  Cuthill,  E.H.  andJ.M.  McKee,  op.  cit. 

8  Cuthill,  E.H. ,  op.  cit. 
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This  procedure  is  carried  out  for  each  possible  starting  node 
previously  selected.  The  sequence  yielding  the  lowest  bandwidth  is 
finally  chosen. 

It  is  apparent  that,  in  the  absence  of  ties  for  a  given  label,  the 
relabeling  sequence  is  independent  of  the  original  numbering  once  a 
starting  node  has  been  selected.  Thus  the  original  nodal  numbering 
has  almost  no  effect  on  the  final  numbering. 

A  secondary  criterion  used  by  BANDIT  in  the  renumbering  is  the 
matrix  profile  P.  (The  definitions  of  P  and  the  semi -bandwidth  B  were 
given  in  Section  IV. )  The  BANDIT  criterion  is  that,  of  those  nodal 
numberings  which  yield  the  lowest  B,  the  one  resulting  in  the  lowest  P 
is  chosen.  This  often  has  a  beneficial  effect  because  NASTRAN  uses 
active  columns  in  matrix  factoring. 

Accordingly,  all  nodes  of  zero  degree  are  numbered  last.  A  node 
of  zero  degree  occurs  in  BANDIT  either  when  selected  directly  by  the 
user  (on  $IGNORE  cards)  or  from  MPC  equations,  in  which  case  the 
dependent  nodes  are  "eliminated”  and  thus  given  zero  degree. 

A  final  attempt  at  reducing  the  profile  still  further  is  made  by 
reversing  the  previous  best  numbering;  i.e. ,  the  nodes  labeled 

9 

1,  2,...,  n  are  relabeled  n,  n-1,  ...,1.  As  pointed  out  by  George  , 
this  frequently  results  in  a  lower  profile  P. 


9  George,  J.A.,  "Computer  Implementation  of  the  Finite  Element 
Method,"  Ph.  D.  Thesis,  Computer  Science  Department,  Stanford 
University,  1971. 
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VII.  DESCRIPTION  OF  THE  CODING 


The  CDC  6400/6600  version  of  BANDIT  consists  of  a  main  program, 
20  FORTRAN  subroutines,  six  FORTRAN  functions,  and  two  routines 
written  in  the  COMPASS  assembly  language.  The  complete  program 
listing  is  given  in  Appendix  A. 

A  second  version  of  BANDIT,  listed  in  Appendix  B,  is  essentially 
the  same  as  the  CDC  version  except  that  all  aspects  of  the  program  which 
are  unique  to  the  CDC  machines  have  been  deleted.  For  example,  the 
COMPASS  routines,  upon  which  the  integer  packing  and  variable-core 
features  depend,  and  all  timing  routines  have  been  removed.  Thus,  this 
version  is  slightly  less  general  than  the  CDC  version.  On  the  other  hand, 
the  integer  packing  is  less  necessary  on  IBM  and  Univac  machines  whose 
word  length  is  shorter  than  the  60-bit  word  length  on  CDC. 

In  this  brief  description  of  the  coding  for  CDC  machines,  the 
differences  between  the  two  BANDIT  versions  are  indicated,  where 
appropriate. 

The  main  program,  called  BANDIT  in  the  CDC  version,  handles 
preliminary  chores  and  controls  some  of  the  output  printing  and  punching. 
CORSIZ  is  called  to  determine  the  amount  of  core  available  for  blank 
common.  GOOGAN  is  called  to  learn  the  user’s  choice  of  $-options  and, 
if  necessary,  to  right-adjust  the  NASTRAN  bulk  data  deck.  The 
partitioning  of  blank  common  is  accomplished  by  a  call  from  GOOGAN  to 
GRID.  BANDIT  then  calls  NASNUM,  which  controls  the  complete 
processing  of  the  NASTRAN  deck  as  directed  by  the  $ -options  chosen  by 
the  user.  BANDIT’S  final  duty  is  to  control  the  listing  of  the  NASTRAN 
deck,  the  punching  of  cards,  and  the  printing  of  the  user  summary. 
BANDIT  output  was  described  in  Section  IV. 
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Subroutine  NASNUM  is  the  executive  for  the  formal  processing 
of  the  NASTRAN  deck  and  is  executed  in  its  entirety  only  if  resequencing 
is  requested.  NASNUM  first  reads  the  deck  and  forms  the  connection 
table  IG.  A  temporary  set  of  node  numbers  (denoted  Set  B)  is  first 
assigned  in  the  order  in  which  grid  points  are  encountered.  The  user’s 
original  grid  numbers  constitute  Set  A.  After  all  cards  have  been 
read,  a  permanent  set  of  internal  numbers  (Set  C)  is  assigned  such  that 
the  user’s  original  grid  point  numbers  are  arranged  in  ascending 
numerical  order.  If  elected  by  the  user,  the  connection  table  IG  is  then 
updated  by  subroutine  TIGER  to  reflect  the  presence  of  MPC  equations. 
Here,  the  new  connections  caused  by  MPC’s  are  generated  and  the  list 
of  dependent  grid  points  is  saved.  Then,  with  subroutine  MORRIS,  all 
dependent  nodes  and  others  chosen  by  the  user  on  $IGNORE  cards  are 
deleted  from  IG.  With  the  connection  table  IG  now  complete,  the  actual 
renumbering  is  performed  by  SCHEME,  which  generates  a  correspondence 
table  between  the  Set  C  numbers  and  a  new  set  of  nodal  numbers,  Set  D. 
The  correspondence  between  the  user's  original  numbers  (Set  A)  and 
the  new  nodal  numbers  (Set  D)  appears  on  the  SEQGP  cards  listed. 

Subroutine  FLIP  converts  an  array  of  original  grid  point  numbers 
to  the  internal  numbers  used  by  BANDIT.  Only  unique  non-zero 
integers  are  retained  in  the  list. 

Subroutine  GOOGAN  reads  a  NASTRAN  data  deck  (ID  card  through 
ENDDATA  card,  inclusive)  and  right-adjusts  all  bulk  data.  It  optionally 
converts  all  cards  with  8-column  field  widths  to  16-column  widths.  It 
is  used  here  to  filter  a  data  deck  so  as  to  retain  only  those  cards 
associated  with  the  structure  geometry.  Finally,  it  reads  the  user's 
$ -option  cards  and  sets  the  appropriate  parameters. 
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Subroutine  GRID  sets  up  the  dimensions  of  all  those  arrays  whose 
lengths  depend  on  either  the  number  of  grid  points  or  the  maximum 
nodal  degree.  The  upper  bounds  on  these  two  quantities  are  stored  in 
MAXGRD  and  MAXDEG,  respectively.  Since  the  entries  in  the  connection 
table  IG  are  packed  with  either  four,  five,  or  six  integers  per  word, 
the  packing  density  is  also  determined  here. 

Subroutine  READIT  is  called  by  GOOGAN  whenever  a  $  card 
containing  integer  data  is  encountered.  This  routine  interprets  and 
stores  in  IP  all  positive  integers  on  the  data  card.  The  variable  NIP 
contains  the  number  of  integers  stored  in  IP.  A(I)  contains  the 
alphabetic  representation  of  the  character  in  card  column  I. 

Subroutine  BOMBIT  is  called  whenever  a  fatal  error  is  detected. 

This  routine  writes  an  appropriate  error  message  onto  both  the  output 
file,  if  necessary,  and  the  CDC  dayfile.  The  job  is  then  aborted  in  order 
to  suppress  the  execution  of  NASTRAN  following  that  of  BANDIT. 

Subroutine  SCAT  is  called  once  for  each  grid  point  appearing  on  a 
connection  card.  The  routine  supplies  a  fast  way  of  determining  for  a 
grid  point  whether  that  point  has  been  encountered  before  and,  if  so, 
which  temporary  internal  number  has  been  assigned  to  it.  This  is 
accomplished  with  the  array  INV(I,  J),  where  INV(1, 1)  contains  an 
original  grid  number  and  INV(1, 2)  contains  the  internal  number  assigned 
to  it.  The  location  I  chosen  for  grid  point  N  is  given  by 

I  =  MOD  (N-l,  KMOD)  +  1  .  (6) 

If  that  location  has  previously  been  selected  for  some  other  point,  the 
first  available  location  following  I  is  used  instead.  The  row  dimension 
of  INV  is  approximately  2*MAXGRD,  where  MAXGRD  is  the  upper 
bound  on  the  number  of  grid  points. 
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Subroutine  BRIGIT  is  called  after  all  connection  cards  have  been 
read  and  the  connection  table  is  complete.  Prior  to  the  call,  the  internal 
numbers  were  assigned  to  the  original  grid  numbers  in  order  of  their 
occurrence.  BRIGIT  performs  a  sort  of  the  original  numbers,  assigns 
new  sequential  internal  numbers,  and  converts  the  connection  table  IG 
and  the  array  NORIG  to  the  new  set  of  internal  numbers.  Here, 

NORIG(I)  contains  the  original  grid  point  number  corresponding  to  the 
internal  number  I. 

Subroutine  SORT  sorts  a  list  of  length  NL.  The  routine  operates 
fastest  on  those  lists  not  badly  out  of  order. 

Subroutine  SETIG  makes  additions  to  the  connection  table  IG.  For 
example,  if  KG1  and  KG2  are  two  connected  grid  points,  this  routine 
sets  IG(KG1,  J)  =  KG2  and  IG(KG2,  K)  =  KG1,  for  some  J  and  K,  if  this 
connection  has  not  already  been  set. 

Subroutine  TIGER  makes  additions  to  the  connection  table  IG 
required  by  the  presence  of  MPC’s.  The  dependent  grid  points  (those 
appearing  first  in  each  equation)  are  stored  in  array  LIST  for  later 
removal  from  IG.  This  routine  is  called  by  NASNUM  and  executed  only 
if  the  user  elects  to  take  the  MPC's  into  account  by  inserting  the  card 
$MPC  YES  into  the  NASTRAN  deck. 

Subroutine  SWITCH  generates  a  new  connection  table  IG  according 
to  a  correspondence  table  KT  which  is  set  up  prior  to  the  call.  Here 
KT(I)  contains  the  new  designation  to  be  assigned  to  the  grid  number 
currently  labeled  I,  i.  e. ,  KT(old)  =  new. 

Subroutine  MORRIS  deletes  all  reference  in  the  connection  table  IG 
to  those  points  stored  in  an  array  LIST  of  length  NL. 

Subroutine  FIXIT  compresses  out  zeroes  and  multiple  entries  in  an 
array  LIST  originally  of  length  NL.  A  corrected  length  NL  is  returned 
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to  the  calling  program. 

Subroutine  SCHEME  is  the  executive  for  the  actual  renumbering 
strategy.  The  principal  quantities  required  before  the  call  are  the 
number  of  nodes  NN,  an  upper  bound  MM  on  the  maximum  nodal  degree, 
and  the  connection  table  IG.  IG  is  an  NN  x  MM  matrix  such  that  a 
typical  element  IG(I,  J)  contains  the  label  of  the  Jth  node  adjacent  to 
node  I.  The  node  labels  referred  to  here  are  the  permanent  (sorted) 
set  of  internal  numbers  assigned  by  BANDIT. 

SCHEME  first  determines  the  degree  of  each  node,  the  most 
prevalent  nodal  degree,  the  number  of  components,  the  maximum  nodal 
degree,  and  the  original  bandwidth.  Then,  for  each  component,  a  list 
of  starting  nodes  is  supplied  by  DIAM  followed  by  a  resequencing  by 
RELABL  for  each  starting  node.  The  numbering  sequence  yielding 
the  lowest  bandwidth  and  profile  is  eventually  chosen  as  the  new 
numbering  sequence.  The  output  from  SCHEME  includes  an  array  ILD, 
where  ILD(I)  contains  the  new  label  corresponding  to  the  original  internal 
label  I. 

Subroutine  STACK  is  called  by  SCHEME  after  the  basic  renumbering 
has  been  completed.  This  routine  determines  all  points  of  zero  degree 
and  places  them  last  in  the  numbering  sequence. 

Subroutine  REVERS  reverses  the  numbering  of  the  first  NN-KT 
grid  points,  where  NN  is  the  total  number  of  grid  points  and  KT  is 
the  number  of  points  of  zero  degree.  The  variable  KT  is  set  in 
subroutine  STACK  prior  to  any  calls  to  REVERS. 

Subroutine  DEGREE  sets  up  the  IDEG  array  containing  in  location 
I  the  degree  of  node  I. 

Function  MODE  has  as  its  value  the  most  prevalent  nodal  degree. 

If  several  degrees  are  equally  prevalent,  the  lowest  is  chosen. 
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Function  COMPNT  has  as  its  value  the  number  of  components 
stored  in  the  array  IG.  This  function  also  sets  up  arrays  IC,  in  which 
the  ith  element  contains  a  component  index  for  the  node  labeled  I,  and 
ICC,  in  which  the  Ith  element  contains  an  index  indicating  the  starting 
position  to  be  used  for  labels  for  component  I.  Thus,  the  number  of 
elements  in  component  I  is  given  by 

ICC  (I +1)  -  ICC  (I)  , 

Function  MAXDGR  has  as  its  value  the  maximum  degree  of  any 
node  of  component  NC  >0.  If  the  formal  parameter  NC  £  0,  all 
components  are  considered. 

Function  MAXBND  has  as  its  value  the  maximum  difference 
between  node  labels  of  connected  nodes  for  nodes  of  component  NC  >  0. 
If  the  parameter  NC  £  0,  all  components  are  considered  and  hence  the 
bandwidth  is  computed.  This  routine  also  computes  IH,  the  matrix 
profile. 

Function  MINDEG  has  as  its  value  the  minimum  degree  of  any 
node  of  component  NC  >0.  If  NC  £  0,  all  components  are  considered. 

Subroutine  DIAM  determines  NL  starting  nodes  and  stores  the  list 
in  the  array  NODESL. 

Subroutine  RELABL  generates  a  relabeling  scheme  starting  with 
NS  nodes  whose  labels  are  stored  in  the  array  NODES.  Although  this 
routine  allows  for  multiple  starting  nodes,  BANDIT  currently  considers 
only  one  starting  node  at  a  time  (corresponding  to  NS  =  1).  The 
relabeling  permutation  developed  by  RELABL  is  stored  in  ILD  and 
NEW.  ILD(I)  contains  the  new  label  for  the  node  labeled  I  in  the  original 
numbering  scheme.  The  NEW  array  is  the  inverse  of  ILD. 

Function  IDIST  has  as  its  value  the  maximum  distance  of  any  node 
in  component  IC(NS)  from  the  node  NS.  The  distance  of  each  node  in 
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this  component  is  stored  in  the  array  IDIS.  The  maximum  number 
of  nodes  at  the  same  distance  from  NS  is  stored  in  ML. 

The  COMPASS  routine  PCUP  has  three  entry  points  used  by 
BANDIT:  PACK,  IUNPK,  and  ABT.  The  first  two  are  for  integer 
packing  and  unpacking,  respectively.  Since  most  of  the  BANDIT 
’  variables  are  integer,  the  CDC  60-bit  word  length  is  wasteful  of 
available  core.  Thus,  to  reduce  the  overall  core  requirements,  the 
connection  table  IG  is  packed  with  four,  five,  or  six  integers  per  word. 
For  example,  instead  of  the  FORTRAN  statement 

IG(I,  J)  =  L  ,  (7) 

we  have 

CALL  PACK(IG,  MAXGRD*(J-1)+I,  NBITIN,  L).  (8) 

Similarly,  instead  of 

M  =  IG(I,  J)  ,  (9) 

we  have 

M  =  IUNPK  (IG,  MAXGRD*(J  -1)+I,  NBITIN).  (10) 

Here,  the  first  three  arguments  refer  to  the  function  name,  the  location, 
and  the  number  of  bits  per  integer,  respectively,  and  MAXGRD  is 
the  row-dimension  of  IG.  Statements  of  these  types  appear  throughout 
the  coding  of  the  CDC  version  of  BANDIT. 

Subroutine  ABT  causes  an  abnormal  termination  of  BANDIT. 

The  other  COMPASS  routine,  CORSIZ,  provides  BANDIT  with 
its  variable-core  feature  by  interrogating  the  system  during  execution 
to  determine  the  field  length  (FL)  and  the  distance  from  the  first  word 
of  blank  common  to  the  end  of  the  FL.  These  values  are  returned  to 
the  calling  program  through  common  block  /K/  . 


24 


The  BANDIT  listing  in  Appendix  B  was  prepared  for  machines  other 
than  CDC  machines  and  omits  the  routines  written  in  the  COMPASS 
assembly  language.  Hence  this  version  of  BANDIT  has  no  integer 
packing  and  is  a  fixed-core  program.  Additional  changes  were  made  in 
BANDIT,  NASNUM,  GRID,  and  BOMBIT  and  given  new  end-punching 
(JJ). 

The  following  disk  files  are  used  by  this  version  of  BANDIT: 

TAPE5  (input),  TAPE6  (output),  TAPE7  (punch),  TAPE9  (scratch), 
TAPEll  (scratch),  and  TAPE8.  The  latter  is  a  BCD  file  which,  after  a 
successful  BANDIT  run,  contains  the  complete  NASTRAN  data  deck. 

The  Appendix  B  version  of  BANDIT  could  easily  be  converted  into 
a  variable-core  program  for  any  machine  for  which  an  assembly 
language  routine  could  be  written  to  determine  the  length  of  blank  common 
storage. 
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appendix  a 

LISTING  OF  THE  CDC  VERSION  OF  BANDIT 


PROGRAM  BANDIT < I NPUT=6Q1 .OUTPUT* 601, PUNCH* 161, INSERT* 161 

» 

BANDIT  2 

1 

1  TAPE5=INPUT,TAP£6=0UTPUT,TAPE7*PUNCH,TAPE12=INSERT, 

BANDIT  3 

2 

2  TAPE <1=8 01,  TAPE 9  =  8 01,  TAPE  11*  161) 

BANDIT  4 

3 

C 

BANDIT  5 

4 

c  bandit 

BANDIT  6 

5 

c 

BANDIT  7 

6 

C  main  PROGRAM  FOR  The  renumbering  of  nastran  GRID  POINTS  for 

BANDIT  8 

7 

C  REDUCED  BANDWIDTH. 

BANDIT  9 

8 

C  THE  NASTRAN  data  DECK  MUST  CONTAIN  a  BEGIN  BULK  CARO  IN  ITS 

BAND  I  T 1 0 

9 

C  PROPER  PLACE  AND  TERMINATE  WITH  AN  ENDOATA  CARD, 

BANDITU 

10 

DIMENSION  A  (  20) 

BANDIT12 

11 

COMMON  K0M( 1000) 

BANDIT13 

12 

COMMON  /S/  NN, MM, IH, IB 

BAND  I  Tl 4 

13 

COMMON  /P/  IHO , I  HE 

BANDIT15 

14 

COMMON  /A/  HAXGRD, MAXDE G» KMOD, NM PC 

BANDIT16 

15 

COMMON  /B/  JPARAMI 20) , IARG(5 ) 

BANDIT17 

16 

COMMON  /C/  IWARN, LINE, KORIG, KNEW 

BANDIT 18 

17 

COMMON  /K/  II <7> ,KORE , IEL 

BANDIT19 

18 

COMMON  /BITS/  NBIT IN, NB ITEX, IPASS 

B ANOl T  20 

19 

COMMON  /TIME/  STIME ,NCOMP 

BANDIT  2 1 

20 

COMMON  / NEL/  NEL,TIM2 

BANDIT22 

21 

COMMON  /DOL/  ISTART (100) ,IGNOREI100) , IFIRST ( 100) 

BAN0IT23 

22 

COMMON  /DOLL/  IDIM , ISTA , I IG, IFIR , IGDEG, ISCH 

BANDIT  24 

23 

COMMON  / ZERO/  KT 

BAN0IT25 

24 

COMMON  /NG/  NGRIO, CLOCK 

BANDIT  2b 

25 

INTEGER  EOF 

BANDIT27 

26 

OAT  A  BEG I,END0,SEQG/4HBEGI ,4HENOD,4HSEQG/ 

BANDIT28 

27 

CALL  SECOND ( T IM1 ) 

BANDIT29 

28 

CALL  ■  REMARK ( 4QH=  =  NASTRAN  --  BANDIT  =  =  ) 

BANDIT30 

29 

CALL  OATE(OAY) 

BANDIT31 

30 

CALL  TIME (CLOCK) 

BANDIT32 

31 

c  determine  kore,  The  dimension  of  the  kom  array,  ano  ifl,  the 

FL  . 

BANDIT33 

32 

CALL  CORSIZ 

BANDIT34 

33 

C  SET  NGRID  OEFAULT. 

BANDIT35 

34 

NGRI0=K0RE/12 

BANDIT36 

35 

IF  (NGRID.GT  .2045)  NGRIO=KORE/l 3 

B AND IT37 

36 

C  SET  SCHEME  DEFAULTS. 

BAND  I T3  8 

37 

IARG  <  1) =80 

BANDIT39 

38 

IARG  <  2)  =  1 

BANDIT40 

39 

IARG<3>=? 

BANDIT41 

40 

I ARG <  4)  =  2 

BANDIT42 

41 

IARG ( 5)  =  0 

BANDIT43 

42 

C  SET  NUMBER  OF  BITS  PER  WORD  FOR  INTERNAL  AND  EXTERNAL 

BANDIT44 

43 

C  GRID  NUMBERS. 

BANDIT45 

44 

NBITIN=12 

BANOIT46 

45 

NBI TE  X  =  6  0 

BANDIT47 

46 

7  FORMA  T  < 1H1 , 16  ( /  ) , 

BANOI  T c* 8 

47 

1  36X, 57H9BH89B  A  A  A A  A  N  N  ODDODD  1 1 1  1 1 1 1 

TTTTTTT/BANOIT49 

48 

2  36X , 57HB  BA  A  NN  NO  D  I 

T 

/BANDIT50 

49 

3  36X ,  57H'J  BA  ANNND  D  I 

T 

/BANOIT51 

5U 

4  36X, 57HBB8BB3B  A  ANNND  D  I 

T 

/BANOIT52 

51 

6  36X,57H9  B'  AAAAAAA  N  N  N  D  D  I 

T 

/BANDIT53 

52 

6  36  X,  57H9  BA  A  N  NN  0  D  I 

T 

/BANDIT54 

53 

7  36X,  57HBDROBB  A  AN  N  ODDDOD  1 1 1  1 1 1 1 

T 

)BAN0IT55 

54 

8  FORMAT (??(/) ,48X,34HTHE0PY  OF  STRUCTURES  BRANCH  (1844)  / 

BANDIT56 

55 

1  46X,38HC0MPUTATI0N  AND  MATHEMATICS  DEPARTMENT  / 

BANDIT57 

56 

2  44X ,  42  HN A V  A  L  SHIP  RESEARCH  AND  DEVELOPMENT  CENTER  / 

B ANDIT58 

57 

3  S3X,24HBFTHESDA,  MARYLANO  20034  ) 

8 AND I T  5  9 

58 

9  FOPMAT  </61X ,8HCDC  6700/57X, 

8ANDIT60 

59 

f  16HREV.  10  MAR  197?  ) 

BANDIT61 

60 

10  FORMAT (20A4) 

BANDIT62 

61 

11  FORMAT (1H  , 2  0  A  4 ) 

BANDIT63 

62 

12  FORMAT ( 1  HI ) 

0ANOIT64 

63 

13  FORMAT (///26H  TOTAL  CP  TIME  IN  BANDIT  =,F9.3,6H  SEC.) 

0ANDIT65 

64 

L I N  E=  55 

0ANOIT66 

65 

KNEW*  0 

BANDIT67 

66 

REWIND  8 

BANDIT68 

67 

C  PRINT  TITLE  PAGE. 

BANDIT69 

68 

WRITE (6, 7) 

BANDIT70 

69 

WRITE  <6, 8) 

BANDIT71 

70 

WRITE (6, 9) 

BANDIT72 

71 

C  INITIALIZE  VARIABLES. 

BANOIT73 

72 

DO  15  J= 1 , 2  0 

BANDIT74 

73 

15  I P  A  R  A  M  ( J  )  ='  0 

BANDIT75 

74 

IPARA  M { 1 2) =  4 

BANDIT  76 

75 

ID  I M=  10  0 

BANDIT77 

76 

ISTA=0 

BAND IT7  8 

77 

1 1  G=  0 

BANOI T79 

78 

ISCH=  0 

BANDIT80 

79 

IF  I R=  0 

BANDIT81 

00 

IGDEG=0 

BANDIT82 

01 

DO  18  1=1, IDIM 

BAN0IT83 

62 

1ST  ART { I ) =0 

BANDIT84 

63 

IFIRST(I)=0 

BANDIT85 

04 

18  IGNOP  E  < I ) =0 

0  AND I T  8  6 

85 

IPASS  =0 

BANDIT87 

86 

NN=  0 

B  ANDI Tfl8 

87 

MM  =  0 

BANDIT89 

86 

MA  XGR  D  =  0 

BANDIT90 

09 

MAXDEG=0 

8AN0IT91 

90 

KMOO=  0 

BANDIT92 

91 

KOR IG  =0 

B ANDIT93 

92 

KNE  W= 0 

BAN0IT94 

93 

stime=o. 

BANDIT95 

94 

NCOMP=0 

BANDIT96 

95 

NE  L  =  0 

BANDIT97 

96 

KT  =  0 

B ANDIT98 

97 

TIM2  =  0 . 

BANDIT99 

90 

REWIND  9 

BANDIIOO 

99 

C  READ  DECK  FOR  FIRST  TIME. 

BAND  1101 

100 

26 


CALL  G00GANd,2,5,9) 

BANDI102 

101 

SLICE  UP  CORE  ACCORDING  TO  SUBROUTINE  GRIO. 

'BANDI103 

102 

K2*II (1) *11 12) ♦! 

BANOI104 

103 

K3*K2*II (3) *2 

BANOUOF 

104 

K4*K3+II(4> 

SANDIlQt 

105 

K5*K4*II  (5) 

BAN0I1Q7 

106 

K6*K5»II (6) 

BANDI108 

lOf 

K7*K6*II  (7) 

BANDI109 

108 

PROCESS  DECK. 

BANDI110 

109 

CALL  NASNUM (KOM (1 ) , I I ( 1 > , KOH ( K2) , II ( 3) , KOM (K3> , KOM ( K4) , K0M( K5), 

BANOI111 

110 

♦  KOM( K6> ( KOM( K7) ,K0M(1> ,K0M(K2)> 

8ANDI112 

111 

ARRAY  STARTING  AT  LOCATION  K7  HAS  DIMENSION  2* MAXDEG 

8AN0I113 

112 

PROCESS  OUTPUT  ACCORDING  To  OUTPUT  REQUESTS. 

6ANDI114 

113 

CHECK  IF  CONNECTION  CAROS  IN  DECK. 

BAND I 115 

114 

IF (IPARAM(9).EQ.3)G0  TO  19 

BANDI116 

115 

REWIND  8 

BANDI117 

116 

REWIND  9 

BANOI118 

117 

FLAG«ENDO 

BAND I 11 9 

118 

J«0 

8ANOU20 

119 

K*9 

BANDI121 

120 

GO  TO  20 

BANOI122 

121 

19  REWINO  8 

BANOI123 

122 

J*0 

BANDI124 

123 

K*  8 

BAND  1 125 

124 

FLAG=ENOO 

8ANDI126 

125 

IF(IPARAM(5) .EQ.4) GO  TO  20 

BAND 1 12  7 

126 

K=  9 

BAN0I128 

127 

IF ( IP ARAM (6) .EQ. 3) FLAG=BEGI 

BANDI 129 

128 

20  REAO(K,10)A 

BAND  1 13  0 

129 

IF (EOF(K) .NE.0)CALL  80MBIT ( 1 ) 

8ANOI131 

130 

J=J  +  1 

BANDI 132 

131 

IF ( IP  ARAM (1 0 ) .EQ.5.AN0. A(l) .NE.SEQG)  J*J-1 

BANDI 133 

132 

IF(MOO(J,LlNEl ,EQ. 11  WRITE ( 6,  12) 

BAN0I134 

133 

IFdPARAM(lO)  .  EQ.6)  WRITE(6,11)  A 

BANDI 135 

134 

IF ( IP  ARAM (10) .EQ.5.ANO. A < 1> . EQ.SEQG)  WRITE  (6,11) A 

BAN0I136 

135 

IFdPARAM(l)  .EQ.2)  WRITE  (7,10)  A 

BANDI137 

136 

IF(IPARAM(l).-EQ.l.  AND.  A  (1)  .EQ.SEQG)  WRITE(7,10)  A 

BANDI 138 

137 

IF ( K. NE • 8)  WRI TE(S,10)  A 

BAN0I139 

138 

IF  ( A ( 1) .HE. FLAG) GO  TO  20 

BAND  1140 

139 

IF ( FL AG. EQ. ENOD) GO  TO  25 

BANDI 141 

140 

FLAG*ENDD 

BANDI 142 

141 

K=5 

8ANDI143 

142 

GO  TO  20 

BAN0I144 

143 

25  CALL  SECOND (TIM2) 

BANDI  145 

144 

TIM2=TIM2-TIM1 

BANDI 146 

145 

IF(IPARAM(5) . EQ . 3) GO  TO  60 

BANOI 147 

146 

IF ( IPARAN(7) .EQ.4) GO  TO  60 

BAN0I148 

147 

IF(IPARAM(9).EQ.4)G0  To  60 

BANDI 149 

148 

USER  SUMMARY. 

BANDI 150 

149 

WRITE  (6,50)  K OR I G, KNEW, TIM2 

BANDI 15 1 

150 

50  F0RMAT(23H1***BANUIT  USER  SUMMARY  / 

BANDI 192 

151 

1  8X , 2  5HORIG INAL  SEMI-BANDWIDTH  =  ,19/ 

B AN0J153 

152 

2  8X.20HNEW  SEMI-BANDWIDTH  =  ,114/ 

BANDI 154 

153 

3  6X, 19HCP  TIME  IN  BANDIT  =  ,F9.3,6H  SEC.  ) 

BANOI 155 

154 

WRITE  (6, 117)  IH 0 , 1 HE 

BANOI 156 

155 

117  F0RMAT(8X,18H0RIGINAL  PROFILE  =, I16/8X, 13HNEW  PROFILE  =,121) 

BANOI157 

156 

WRI TE  (6 , 104 )  NN 

BANDI158 

157 

WRITE  (6, 113)  NEL 

BANOI 159 

158 

WRI TE  (6,112)  NCOMP 

BANDI 160 

159 

WRITE  (6 , 107 )  MM 

BAN0I161 

160 

107  FORMAT(8X,22HMAXIMUM  NOOAL  DEGREE  =  ,112) 

BANDI 162 

161 

WRITE (6, 116)  KT 

BANDI163 

162 

I=IPARAM(1) 

BAN0I164 

163 

IF(I.EO.l)  WRITE (6,101) 

BANDI 165 

164 

IF ( I , EQ. 2)  WRITE  (6, 102) 

BAN0I166 

165 

IF ( I . EQ. 3)  WRITE (6,103) 

BANDI167 

166 

101  FORMAT (8X,34HPUNCH  OUTPUT  SEQGP  CAROS  ) 

BANOI 168 

167 

10?  FORMAT (8X,34HPUNCH  OUTPUT  ALL  CARDS  ) 

BAN0I169 

168 

103  FORMAT(8X,34HPUNCH  OUTPUT  NONE  ) 

8AN0I17  0 

169 

WRITE (6, 119)  IFL 

BANDI171 

170 

WRITE  (6, 105)  MAXGRO, MAXDEG 

BANDI 172 

171 

105  FORMAT( 18X, 8HMAXGRD  = , I11/18X , 8HMAXDEG  *  ,111) 

BANDI 173 

172 

WRITE (6, 109)  KORE , KORE 

BANDI174 

173 

109  FORMAT (18X,6HK0RE  =, I i3/ 18X, 6HK0RE  =,6X,06,1HB) 

BAND 117  5 

174 

WRITE  (6 , 111 )  DAY, CLOCK 

BAN0I176 

175 

111  FORMAT (BX,14H0ATE  AND  TIME  ,2A10) 

BANDI177 

176 

I P AS  S  =  NUM  BER  OF  PCUP  CALLS. 

BANOI 178 

177 

104  FORMAT  <8X,23HNUMBER  OF  GRID  POINTS  =  ,111) 

BANDI179 

178 

113  FORMAT(8X,20HNUMBER  OF  ELEMENTS  =  ,114) 

BANDI 180 

179 

112  FORMAT(8X,22HNUMBER  OF  COMPONENTS  =  ,112) 

BANDI 181 

180 

116  FORMAT (8X,28H#  OF  POINTS  OF  ZERO  OEGREE  =  ,16) 

BANOI 182 

181 

119  FORMAT (8X,19H FIELD  LENGTH  (FL)  =  ,8X,06,1H8) 

BANDI 183 

182 

GO  TO  70 

BANDI 184 

183 

60  IF ( IP ARAM (10) . EQ. 5 )  WRITF(6,12) 

BANDI185 

184 

WRITE (6,13)  T I M2 

BAN0I186 

185 

70  CONTINUE 

BANOI187 

186 

REWIND  8 

BANOI188 

187 

IF(IPARAM(8) .EQ.4)  STOP  5 

BANDI 190 

188 

STOP 

BANOI 191 

189 

END 

BAN0I192 

190 

SUBROUTINE  NASNUMdG,  1 1 1 ,  INV ,  1 13 ,  INT  , ICC ,  I LD , NORIG ,  IP,  JG,  JNV) 

NASNUM  2 

191 

DIMENSION  A(6) , KG ( 40 )  ,L  G (40 )  , L IN  E ( 1 0 ) ,9(20),ATEMP(4) 

NASNUH  3 

192 

DIMENSION  I G ( 111,1) ,INV( 113,2) ,JG(1) ,JNV(1) 

NASNUM  4 

193 

DIMENSION  INT (1) , ICC ( 1 ) , ILO (1 ) , NORIG (1) , IP ( 1) 

NASNUM  5 

194 

IP  HAS  DIMENSION  2*MAX0EG.  JG  ANO  JNV  ARE  EQUIV  TO  IG  AND  INV. 

NASNUM  6 

195 

COMMON  /S/  NN,MM , IH, I 9 

NASNUM  7 

196 

COMMON  /A/  MAXGRD, MAXDEG, KMOO,NMPC 

NASNUM  8 

197 

COMMON  /B/  IPARAM(20) ,IARG(5) 

NASNUM  9 

198 

COMMON  /c/  iwarn,nline,korig,knew 

NASNUM1 0 

199 

COMMON  /BITS/  NBI T IN, N9 ITEX, IPASS 

NASNUM11 

200 

27 


COMMON  /K/  11(7)  ,KORE 
COMMON  /TIME/  TIM2,NCOMP 
COMMON  /NEL/  NEL 

COMMON  /QOL/  ISTARTUOO) , IGNORF< IDO) ,IFIPST( 100) 

COMMON  /DOLL/  IOIM , IS T A , I IG , I F IR , IGOEG , TSC H 
C  THE  VARIABLE  LINE  OEFINEO  NEAR  CAPO  N ASNUM ,300  IS  NOT  THE 
C  SAME  A  5  THE  VARIABLE  LINE  APPEARING  IN  COMMON 

C  IN  OTHER  ROUTINES. 

DIMENSION  TYPE (50) ,WYPF (50 > 

0 1  MENS  I  ON  F  1  A ( 2 )  ,  F  1 0  A  ( 2  )  ,F1B(?)»F10B(2> 

DATA  BFGI»rN0l),SEQG/4HHEGI  , 4  HE NOO , 4HSEQG/ 

DATA  T  YPE/4HCf)AR,4HCEL  A  ,4HCEL  A ,4HC0NR,4HCQDM ,4HCQDP ,4HCQUA 

1  4HC0UA,4HCQUA,4HCR00,4HCSHE,4HCTRB,4HCTRI ,4HCTRI , 4HCTRM 

2  4HCTRP,4HCTUB,4HCTWI , 4HEN00 ,4HMPC*  , 4HCDAM ,4HC0AM  t4HCMAS 

3  4HCMAS,4HCVIS»4HC0AM ,4HCDAM  ,4HCEL A , 4 HCELA ,4HCMAS ,4HCMAS 

4  4HCC0N»4HCT0R,4HCTRA,4HCTRI ,  4 HCONM , 4HCONM , 4HCHTT ,4HCIS3 

5  4HCIS3,4HCIS?»4HCIS2 , 4HC I SH  ,4HC I SH,4HCFLU , 4 HCFL U , 4HC FLU 

6  4HCTET,4HCHEX,4HCHEX/ 


DAT  ft  WYPE/4  H* 

,  4  HS1 • 

,  4HS2  • 

,4  HOD* 

, 4HEM  * 

,  4  HL  T* 

4HD 1*  , 

NASNU  M3  0 

219 

1 

4H02* 

,  4HD  3* 

,4H* 

,4HAR* 

4  HSC* 

,  4HA 1  • 

,  4  H  A  2* 

♦4HEM*  , 

NASNUH3 1 

220 

2 

4HLT* 

4HE  * 

4 HST  • 

, 4H AT  A 

,4  H 

,  4  H  P  1  * 

,4HP2* 

,  4H  S 1*  , 

NASNUM32 

221 

3 

4HS2» 

4  HC  • 

,4HP3* 

, 4  H  P4 • 

4HS3* 

, 4  HS  4  * 

4  H  S.3  • 

,  4HS4*  , 

NASNUM33 

222 

4 

4HE AX ♦ 

4HDRG* 

4  HPRG* 

, 4H  AR  G* 

,  4  H 1  • 

,  4H2* 

,4  HR  12* 

,  4HD  8*  , 

NASNUM34 

223 

5 

4H  02  0  • 

4H04* 

,  4  HDft  • 

,4H8* 

,  4H 16* 

,  4  H I D  2* 

,4H I 03* 

,4HI04», 

NASNUM35 

224 

6 

4H  RA  • 

4  H  A  1  • 

4HA2  • 

/ 

NASNUH36 

225 

NASNUM12 
NASNUM13 
NASNUML4 
NASNUH1 5 
NASNUM16 
N ASNUM 1 7 
NA5NUM1 8 
NASNUM19 
NASNUM20 
NASNUM21 
NASNUM22 
N  ASNUM2  3 
NASNUM2  4 
NASNUM25 
NASNUM26 
NASNUM27 
NASNUM28 
NASNUM29 


NTYPE=S0  ' 

REWIND  8 
REWIND  9 
NMPC=40 

KMOD=2.*FLOAT (MAXGRO) -2.2715*SQRT (1*131* FLOAT (MAXGRO)  ) 

NF  W  =  0 

IWARN=0 

NEQ*0 

2  FORMAT (29HlflAN0IT  INFORMATION  MESSAGE  - 
M9H  NO  GRID  POINTS/ 

♦  28H  RESEQUENCING  SUPPRESSED) 

4  FORMA  T (  1 9H  ***NEW  BANDWIDTH  =  ,I6> 


NASNUM37 

NASNUM38 

NASNUM39 

NASNUM40 

NASNUM41 

NASNUM42 

NASNUM43 

NASNUM44 

NASNUM45 

NASNUM46 

NASNUM47 

NASNUM48 


S  FORMA  T ( 3  3H1 THE  WRONG  CARO  FOLLOWS  THIS  CARD/ IX , 2 A4 , 1P4E 16 . 7 , 2 A4 //  N  ASNUM49 


2  4  OH  THE  CONTINUATION  CARO  IS  REQUIRED  NEXT  , 

3  36HSINCE  BANDIT  DOES  NOT  SORT  THE  DECK. 

4  13H  FATAL  ERROR.  > 

6  FORMA  T ( 1  HI ) 


NASNUM50 
NASNUM5 1 
NASNUM52 
NASNUM53 


7  FORM A  T ( 54H1  ONE  OR  MORE  SEQGP  CARDS  ALREADY  APPEAR  IN  DATA  DECK./  N ASNUM54 

f  55H  RESFQUENCING  CANNOT  BE  REQUESTED.  FATAL  ERROR.  )  N ASNUM55 

8  EORMAT(SHSEQGP, 3X,2I8,S6X)  NASNUM56 

9  FORMAT (20A4)  N ASNUM5 7 

10  FORMAT (?A4,4Fl6«0,2A4)  N ASNUM5 8 

11  FORMA  T ( 1H  ,5< 18, I11,7X) )  N  ASNUMS9 

12  FORMAT (5HSFQGP,3X, 618, 8X)  NASNUM6Q 

14  F0RMAT(////26H  •♦•BANDIT  WARNING  MESSAGE  /  NASNUM6 1 

1  11X,35HTHF  WRONG  CARO  MAY  FOLLOW  THIS  CARO  /  NASNUM62 

2  1 1 X ,2A4, 1P4E16.7 ,2A4/  N ASNUM63 

3  11X,47HCHECK  INPUT  DECK  TO  BE  SURE  THAT  A  CONTINUATION  ,  NASNUM64 

4  42H  CARO  IS  NEITHER  MISSTNG  NOR  OUT  OF  SORT.  )  N ASNUM65 

15  FORMA  T ( 26H  TOTAL  CP  TIME  IN  SCHEME  =  ,F9.3,6H  SEC.  )  NASNUM66 

19  FORMAT (1H1,5(20HINTERNAL  OR IG I N AL ,6X ) /  NASNUM67 

11H  , 5 ( 20HGP 1 0  NO.  GRID  PT.,6X))  NASNUM68 

C  RETURN  IF  RESEQUENCING  IS  NOT  OESIREO.  N ASNUM69 

IF ( IPARAM(5) *EQ.3)RETURN  NASNUM70 

C  CHECK  IF  SEQGP  CARDS  ALREADY  APPEAR  IN  DECK.  NASNUM7 1 

IE  < IPARAM(7> . EQ . 3 ) GO  To  22  N A SNUM72 

C  ABORT  BANOIT  SINCE  SEQGP  CARDS  ALREADY  APPEAR  IN  DECK.  N  ASNUM7  3 

WRITE  (6, 7)  NASNUM74 

CALL  BOMB  IT ( 3 )  NASNUM75 

C  READ  AND  EXTRACT  CONNECTION  CAROS  FROM  OECK.  N ASNUM76 

22  CALL  G00GAN ( 2 , 1 , 9, 8 )  NASNUM77 

REWIND  8  NASNUM76 

REWIND  9  NASNUM79 

C  INITIALIZE  EXPANDABLE  CORE.  NASNUM80 

DO  30  I  =  1 , K  ORE  NASNUM81 

30  JG ( I ) =0  NASNUM82 

C  READ  CARD.  NASNUM83 

40  READ(8,10)F1A, (A(I), 1=1,4) ,F10A  N ASNUM84 

C  DETERMINE  CARD  TyPE.  NASNUM85 

45  ITYPE=0  NASNUM86 

DO  50  1= 1 , NTYPE  NASNUM87 

50  IF(F1A(1).EQ.TyPE(I) .ANO.F1A (2).EQ.WYPE(I) )  lTYPE  =  I  N AS NUMB 8 

IF( ITYPE .EQ. 0)GO  TO  40  N ASNUM89 

IF( ITYPE.EQ. 19) GO  TO  500  NASNUM90 

IF ( IT YPE  *EQ. 20. AND. IPARAM (4) .EQ. 3) GO  To  40  NASNUM91 

C  READ  CONTINUATION  TO  CARD  JUST  REAO.  NASNUM92 

READ(8,10)F1B, (A(I),I=5,8) , F 1 0  B  NASNUM93 

C  CHECK  EACH  LOGICAL  CARD  FOP  PROPER  SORT.  NASNUM94 

IF(F1B<1) .EQ.F10AI 1) . AND. FIB ( 2 ) . EQ. FI 0 A ( 2) )  GO  TO  60  NASNUM95 

C -  IF  FOLLOWING  CARD  TYPES  ARE  OUT  OF  SORT,  NO  ERROR  N ASNUM96 

IF< ITYPE, EQ.l. OR. ITYPE.EQ. 4)  GO  TO  56  NASNUM97 

IP ( ITYPE *EQ.32)G0  TO  56  N ASNUM98 

IF(ITYPE,EQ.33)GO  TO  56  N ASNUM99 

IF<ITYPE,EQ.35)GO  TO  56  NASNU100 

IF(ITYPE,E0.36)G0  TO  56  NASNU101 

IE  C ITYPE  *EQ.37)G0  TO  56  NASNU102 

IFIITYPE.EQ. 45. OR. ITYPE.EQ. 46)  GO  TO  56  NASNU10  3 

C—  IF  FOLLOWING  CARD  TYPES  ARE  OUT  OF  SORT,  POSSIBLE  ERROR  (GIVE  NASNU104 

C -  WARNING  MESSAGE)  NASNU105 

IWARN  =  IH ARN  +  1  N  ASNU1 0  6 

IF (MOD (I  WARN, 6) ,EQ.l) WRITE (6,6)  NASNU 10 7 

IF ( ITYPE .EQ.  2)  GO  TO  54  NASNU 10 8 

IF ( ITYPE .EQ.  3)  GO  TO  54  N ASNU109 

IF (IT  YPE .EQ. 10)  GO  To  54  NASNU11Q 

IF ( ITYPE .EQ. 17)  GO  TO  54  NASNU111 
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IFCITYPE.GC  .21.  AN0.ITYPE.LE.3DG0  TO  54 

NASNU112 

301 

C -  FOR  OTHER  CARO  TYPES  OUT  OF  SORT,  ABORT  BANDIT 

NASNU113 

302 

52  WRITE (6, 5>F1A, (A(I) ,1=1,4) ,F10A 

NASNU1 1 4 

303 

CALL  10MBIT(2) 

NASNU115 

304 

54  WRITE (6, 14) FI  A,  (A (I), 1=1,4) , FI OA 

NASNU11 6 

305 

C  SAVE  CONTENTS  OF  THE  SECOND  CARO  OF  THE  PAIR'. 

NASNU117 

306 

55  DO  56  1=1,4 

NASNU11 6 

307 

ATEMP (I) =A(I+4> 

NASNU11 9 

308 

5a  A(I+4)=0. 

NASNU120 

309 

C  INITIALIZE  KG  ANO  LG. 

NASNU121 

310 

50  00  70  1=1, NHPC 

NASNU122 

311 

KG( I ) =0 

NASNU123 

312 

70  LG ( I ) =0 

NASNU124 

313 

LOOP=l 

N ASNU125 

314 

NCON  =  4 

NASNU126 

-.5 

C  SET  UP  kg  ANO  LG.  ** 

NASNU127 

316 

GO  TO  (160,220,220,200,120,120,120,120,120 

,180 

,120,140,140, 

NASNU126 

317 

1  140,140,140,180,120,500,230,220,220 

,220 

,220, 160,160, 

NASNU129 

318 

2  180 ,180,180 ,180 ,180,160,160, 110, 114 

,118 

,116,140,  60, 

NASNU130 

319 

3  85,120,  90,  80,  95,200,114,110,120 

»  90 

,  90 ) , ITYPE 

NASNU131 

320 

C*  CIS  3D8 i C ISH8 

NASNU132 

321 

80  OO  81  1=1,7 

NASNU133 

322 

81  KG(I)=A(!+l)+0.5 

NASNU134 

323 

NCON=  8 

NASNU135 

324 

RE AO (8,10)  F1A,A(1),A(2)  , A  (3 )  , A ( 4 ) , F 1 0 A 

NASNU136 

325 

IF(F1A(1).NE.F10B(1).OR.F1A(2).NF.F106(2)) 

GO 

TO 

100 

NASNU137 

326 

KG ( 8) =A( 1) *0.5 

NASNU138 

327 

GO  TO  250 

NASNU139 

326 

C*  CIS 3020 

NASNU140 

329 

85  00  86  1=1,7 

NASNU141 

330 

86  KG ( I ) =A ( 1*1 ) +0  •  5 

NASNU142 

331 

NCON=  20 

NASNU143 

332 

RE  AD (8,10)  F1A,A(1),A(2),A(3),A(4),F10A 

NASNU144 

333 

IF (FI  A (1) .NE,F1O0(1).OR.F1A(2) .NE.F 109(2)1 

GO 

TO 

100 

NASNU145 

334 

RE AD (8, 10)  FIB , A ( 5) ,A(6) ,A(7) ,A(8) , F10B 

NASNU146 

335 

IF(F19(1) .NE.FlOA(l) ,0R.F1B(2) .NE.F10AI2) ) 

GO 

TO 

52 

NASNU147 

336 

DO  87  1=9,15 

NASNU148 

337 

87  KG ( I ) = A ( 1-7) *0.5 

NASNU149 

338 

RE AO (8, 10)  F1A,A(1),A(2),A(3),A{4),F10A 

NASNU150 

339 

IF(F1A(1).NE.F10B(1) .OR. FI A (2) .NE.F 100(2) ) 

GO 

TO 

100 

NASNU151 

340 

READ (8, 10)  F1B,A(5) ,A (6) ,A (7) ,A(8),F10B 

NASNU152 

341 

IF(F1B(1) .NE.F10A(1).OR.F10(2) .NE.F10A(2) ) 

GO 

TO 

52 

NASNU153 

342 

00  88  1=16,20 

NASNU154 

343 

88  KG ( I ) =A ( 1-1 5) +0 . 5 

NASNU155 

344 

GO  TO  250 

NASNU156 

345 

C*  CIS2D8,CHEXA1,CHEXA2 

NASNU157 

346 

90  00  91  1=1,6 

NASNU158 

347 

91  KG ( I ) =A ( 1*2 ) ♦ 0 • 5 

NASNU159 

348 

NCON=  9 

NASNU160 

349 

RE  AO ( 8  , 1 0 )  F1A,A(1) ,A(2) ,A(3) ,A(4) ,F10A 

NASNU161 

350 

IF(F1A(1) .NE.F10B( 1) .0R.F1A(2) .NE.F10BC2) ) 

GO 

TO 

100 

NASNU162 

351 

DO  92  1=7,8 

N ASNU163 

352 

92  KG ( I) =A ( 1-6) *0.5 

NASNU164 

353 

GO  TO  250 

NASNU165 

354 

C*  CISH16 

NASNU166 

355 

95  DO  96  1=1,7 

NASNU167 

356 

96  KG ( I ) =  A ( 1+1 )  +  0. 5 

N ASNU168 

357 

NCON= 16 

NASNU169 

358 

READ (8,10)  FI A, A(l) ,A (2) ,A(3),A(4),F10A 

NASNU17  0 

359 

IF (FI  A (1)  .NE. FI 08(1). OR. FI  A (2)  . NE.F 1  OB (2)) 

GO 

TO 

100 

NASNU171 

360 

RFAD(8,10)  F1B,A(5),A(6),A(7),A(8),F109 

NASNU172 

361 

IF (FI  9(1) .NE.FlOA(l) .OR. FIB (2) .NE.F10A(2) ) 

GO 

TO 

52 

NASNU173 

362 

DO  97  1=8,15 

NASNU174 

363 

97  KG ( I ) = A ( 1-7 ) *0 . 5 

NASNU175 

364 

READ (3, 10)  F1A,  A(1),A(2) ,A(3) ,A(4) ,F10A 

NASNU176 

365 

IF (FI A(1 ) .NE. FI  08(1) .OR. FI A (2) .NE.F108(2) ) 

GO 

TO 

100 

NASNU177 

366 

KG ( 16 ) =A  (1)  +0.5 

NASNU178 

367 

GO  TO  250 

NASNU179 

368 

100  FI A ( 1 ) =F18 ( 1) 

NASNU160 

369 

F1A (2 ) =F1B ( 2) 

NASNU181 

370 

00  101  1=1,4 

NASNU182 

371 

101  A ( I )  =  A ( 1+4) 

NASNU183 

372 

F10A( 1) =F109(1) 

NASNU184 

373 

F10A(2)=F10B(2) 

NASNU185 

374 

GO  TO  52 

NASNU186 

375 

C*  CTRAPRG, CFLUI04 

NASNU187 

376 

110  DO  112  1=1,4 

NASNU168 

377 

112  KG(I)=A(I*1>*0.5 

NASNU189 

378 

GO  TO  250 

NASNU190 

379 

C*  CTRIARG»CFLUI03 

NASNU191 

380 

114  00  116  1=1,3 

NASNU192 

381 

116  KG<I)=A(Ifllt0.5 

NASNU193 

382 

GO  TO  250 

NASNU194 

383 

C*  C  ON  HI ,  C0NM2 

NASNU195 

384 

118  KG(1) =A(2)*0.5 

NASNU196 

385 

KG ( 2) =KG ( 1 ) 

NASNU197 

366 

GO  TO  250 

NASNU198 

387 

C*  CQO HEM, C0DPLT,CQUAD1,CQUA02,CQUA03,CS HEAR, CTHIST, 

CIS204,CTETRA 

NASNU199 

386 

120  DO  130  1=1,4 

NASNU200 

389 

130  KG(I>=A(If2)+0.5 

‘ 

NASNU201 

390 

GO  TO  250 

NASNU202 

391 

C*  CTRBSC,  CTRIA1,  CTRIA2,  CTRMEM,  CTRPLT,  CHTTRIB 

NASNU203 

392 

140  00  150  1=1,3 

NASNU204 

393 

150  KG ( I) =A ( 1*2 ) +0 • 5 

NASNU20  5 

394 

GO  TO  250 

NASNU206 

395 

C*  CBAR,  CCONEAX,  CTORORG 

NASNU207 

396 

160  00  170  1=1,2 

NASNU206 

397 

170  KG(I)=A(I*2>*0.5 

NASNU209 

398 

GO  TO  250 

NASNU21 0 

399 

C*  CROO,  CTUBE ,  CVISC,  COAMP3 ,  CDAMP4,  CELAS3 ,  CEL AS4 , 

CHASS3,  CHASS4 

NASNU211 

400 

29 


180  DO  190  1=1,2 

N ASNU212 

401 

.  KCIIJ =A(If2»+0.5 

NASNU213 

402 

190  LG<I>=A(I+6)»0.5 

NASNU214 

403 

C  SET  LOOP2  2  SINCE  2  ELEMENTS  MAY  BE  DEFINED  ON 

ONE  CARD. 

NASNU215 

404 

LOOP=2 

NASNU216 

405 

GO  TO  250 

NASNU21 7 

406 

C*  C0NR0D,CFLUID2 

NASNU218 

407 

200  DO  210  1=1,2 

NASNU219 

406 

210  KG* I) =A(I+l>+0.5 

N ASNU220 

409 

GO  TO  250 

NASNU221 

410 

C*  CEL  AS  1 ,  CELAS2,  COAMP1,  CDAMP2,  CMASS1, 

CMASS2 

NASNU222 

411 

220  KG < 1) =A< 3) +0.5 

NASNU223 

412 

KG  ( 2  > =A ( 5>  +  0.5 

NASNU224 

413 

GO  TO  250 

NASNU225 

414 

C  PROCESS  M PC  CAROS. 

NASNU226 

415 

230  NCON=  NMPC 

NASNU227 

416 

KG(1) =A (?) *0.5 

NASNU228 

417 

KG  *  2) =A( 5)  +  0.5 

NASNU229 

416 

1=2 

NASNU230 

419 

240  READ(8,10)F1A, (A(J)9J«194> ,F10A 

NASNU231 

420 

IF* FI  OB* 1> .NE.F1A( 1) . OR . F IQB ( 2  ) . NE , F 1  A ( 2 ) ) 

GO  TO 

250 

NASNU232 

421 

1=1  +  1 

NASNU23  3 

422 

IF* I.GT. NMPC) GO  TO  245 

NASNU234 

423 

F10B* 1) =F10A* 1 ) 

NASNU235 

424 

F10B*  2)=F10A<2) 

NASNU236 

425 

KK=  2 

NASNU23  7 

426 

IF  *  MO  0*  I  ,  2)  .  EQ.  0  )  KK  =  1 

NASNU238 

427 

KG < I ) =A  *  KK) +0.5 

NASNU239 

428 

GO  TO  240 

NASNU240 

429 

245  WRITF (6, 246)  NMPC 

NASNU241 

430 

246  FORMAT ( 3 6H1  AN  MPC  EQUATION  CONTAINS 

MORE 

THAN, 15 

,8H  TERMS./ 

NASNU242 

431 

♦  14H  FATAL  ERROR.  ) 

NASNU243 

432 

CALL  BOMBIT  *5) 

NASNU244 

433 

C  PROCESS  KG  (AND  LG  IF  LOOP=2)  ARRAY. 

NASNU245 

434 

250  00  480  KK- 1 , LOOP 

NASNU246 

435 

IF(KK.FQ.l) GO  TO  300 

NASNU247 

436 

DO  260  1=1,4 

NASNU248 

437 

260  KG* I) =LG  *  I) 

NASNU249 

438 

C  SCATTER  SEARCH  AND  CONVERT  KG  TO  TEMPORARY  SET 

OF  INTERNAL  NUMBERS. 

NASNU250 

439 

300  CALL  SCAT*KG, NCON, NEW, INV, II?, NORIG) 

NASNU251 

440 

IF*ITYPE.NE.20)GO  TO  420 

NASNU252 

441 

C  SAVE  MPC  GRID  POINTS  FOR  LATER  PROCESSING 

3Y  TIGER. 

NASNU253 

442 

NEQ=NEQ+ 1 

N ASNU254 

443 

WRITE (ll)KG 

NASNU255 

444 

GO  TO  45 

NASNU256 

445 

C  FILL  CONNECTION  TABLE  ARRAY  IG. 

NASNU257 

446 

423  IENO  =  NCON- 1 

NASNU258 

447 

NEL=NEL+ 1 

NASNU259 

448 

DO  450  1=1, TEND 

NASNU260 

449 

L=  I  + 1 

NASNU261 

450 

DO  450  J=L , NCON 

NASNU262 

451 

450  CALL  SETIG (KG( I) ,KG* J) , IG, III, NORIG) 

NASNU263 

452 

480  CONTINUE 

NASNU264 

453 

IF(F1B(1) .EQ.FlOA(l). AN 0. F IB  *  2 ) . EQ . F 1 0  A *2) )  GO  TO 

40 

NASNU265 

454 

IF (NCON. GE, 8)  GO  TO  40 

NASNU266 

455 

F1A  < 1 )  =F1B( 1) 

N ASNU267 

456 

FI  A  ( 2  )  =F  If)  <  2  ) 

NASNU268 

45  7 

DO  495  1=1,4 

NASNU269 

458 

495  A*I)=ATEMP*I) 

NASNU270 

459 

F10A*1)=F10B(1) 

NASNU271 

460 

F10A(2)=FlO-3*2) 

NASNU272 

461 

GO  TO  45 

NASNU273 

462 

500  NN=NE  W 

NASNU274 

463 

IF (NEW.GT.O)  GO  TO  502 

NASNU275 

464 

WRITE  (6,2) 

NASNU276 

465 

IPARAM<9>=4 

N ASNU277 

466 

RETURN 

N ASNU278 

467 

502  IF*  IPARAM(4)  .EQ.3) GO  TO  505 

NASNU279 

468 

C  MODIFY  CONNECTION  TABLE  TO  ACCOUNT  FOP  MPC 

EQUATIONS. 

NASNU280 

469 

CALL  TIGER(NEQ,IG, III, ILD, NORIG) 

NASNU281 

470 

NDF  P=  NN 

NASNU282 

471 

CALL  FIX  IT ( ILD, NDEP) 

NASNU283 

472 

C  GENERATE  NEW  IG  AND  NORIG  ARRAYS. 

NASNU284 

473 

505  CALL  DRIGIT * IG, III ,INV, 113 , INT , ICC, NORIG, IP) 

NASNU285 

474 

C  PRINT  INTEPNAL/EXTERNAL  CORRESPONDENCE  TABLE. 

NASNU286 

475 

LE  N  =  5  0 

NASNU287 

476 

IF  *IPARAM(10) • t  Q • 5 )  GO  TO  560 

NASNU288 

477 

J=0 

NASNU289 

478 

510  WRITE  *6, 19) 

NASNU290 

479 

520  J=J+1 

NASNU291 

480 

KEND=  0 

NASNU292 

481 

DO  530  K  =  1 , 9 , 2 

NASNU293 

482 

L  =  J*LEN*  *  K- 1 ) / 2 

NASNU294 

483 

LINE*  <) =L 

NASNU295 

484 

IFtL.GT.NEW)  GO  TO  550 

NASNU296 

485 

KENO=K+l 

NASNU297 

486 

530  LINE(K+1)=N0RIG*L) 

NASNU298 

487 

550  CONTINUE 

NASNU299 

488 

IF*  KEND. EQ. 0) GO  TO  560 

NASNU3Q  0 

489 

WRITE *6,  ID  *LINE*K) ,K  =  1,KEND) 

NASNU301 

490 

IF (MOD* J,LEN) .NE.O)GO  TO  520 

NASNU302 

491 

J=J+4*LEN 

NASNU303 

492 

IF ( J. LT. NEW)  GO  TO  510 

NASNU304 

493 

560  CONTINUE 

.  NASNU305 

494 

C  CONVERT  ISTART, IGNORE, IFIRST  FROM  ORIGINAL 

TO  INTERNAL 

NUMBERS. 

NASNU306 

495 

IsISTA+I  IG+IEIR 

NASNU307 

496 

IF(I.LE.O)  GO  TO  570 

NASNU30  8 

497 

CALL  FLIPIISTART ,I$TA,INV,II3»ICC) 

NASNU30  9 

498 

CALL  FL I p  ( I GNORE , I IG  , INV , II 3 ,  ICC) 

NASNU310 

499 

CALL  FLIP* I FIRST, I FIR, INV, II 3, ICC) 

NASNU311 

500 

30 


IF( IPARAN(ia) ,EQ.5)  GO  To  570 

NASNU312 

501 

c 

PRINT  INTERNAL  NUMBERS  FOR  t-CARDS. 

NASNU313 

502 

WRITE (6,  561 ) 

NASNU314 

503 

561  FORMAT ( 3 0H1  $  CAROS  (INTERNAL  NUMBERS)  /) 

NASNU315 

504 

IF(ISTA.GT.O)  WRITE (6,562)  ( ISTART < I ) , 1*1, ISTA) 

NASNU316 

505 

IF ( II G  .GT.Q)  WRITEC6,564)  (IGNORE (I), 1*1, IIG  ) 

NASNU317 

506 

IF(IFIR.GT.Q)  WRITE (6,566)  ( IF IRST ( I ) , 1*1 , IFIR) 

NASNU318 

507 

562  FORMAT ( 9H  ISTART  , 20 15/10 0 ( 9X ,2 0 15/ ) ) 

NASNU319 

508 

564  F0RMAT(9M  SIGNORE  , 20 I 5/ 100 ( 9X , 20 15/ ) ) 

NASNU320 

509 

566  FORMA T ( 9H  tFIRST  ,20 15/ 10 0  ( 9X , 20 15/ ) ) 

NASNU321 

510 

570  CONTINUE 

NASNU322 

511 

c 

SET  UP  LIST  OF  POINTS  TO  IGNORE  IN  INT  ARRAY. 

NASNU323 

512 

K*0 

NASNU324 

513 

IF(IPARAM(4) .  EQ.3)  GO  To  920 

NASNU325 

514 

IF(NOEP.LE.O)  GO  TO  920 

NASNU326 

515 

c 

MPC  DEPENDENT  POINTS  FIRST. 

NASNU327 

516 

00  915  1*1, NDEP 

NASNU328 

517 

J*ILO(I) 

NASNU329 

518 

IF(J.LE.O)  GO  TO  915 

NASNU330 

519 

K=K*  1 

NASNU331 

520 

INT ( K ) = ICC ( J) 

NASNU332 

521 

IF(K.GE.MAXGRO)  CALL  FIXIT(INT,K) 

NASNU333 

522 

915  CONTINUE 

NASNU33  4 

523 

920  IF(IGOEG.LE.O)  GO  TO  940 

NASNU335 

524 

c 

GRID  POINTS  WITH  DEGREE. GT . IGOEG  SECOND. 

NASNU336 

525 

IF(IGOEG.GE.MM)  GO  TO  940 

NASNU337 

526 

CALL  DEGREEdG,  II1,INV> 

NASNU338 

527 

c 

HERE,  INV(I) =OEGRE£  OF  GRID  POINT  I 

NASNU339 

528 

DO  930  1=1, NN 

NASNU340 

529 

IF ( JNV(I) .LE.IGDEG)  GO  TO  930 

NASNU341 

530 

K*KU 

NASNU342 

531 

INT IK  >  =  I 

NASNU343 

532 

IF ( K. GE • MAXGRD)  CALL  FIXIT(INT,K) 

NASNU344 

533 

930  CONTINUE 

NASNU345 

534 

940  IF ( I IG. LE . 0 )  GO  TO  960 

NASNU346 

535 

c 

SIGNORE  POINTS  THIRD. 

NASNU347 

536 

00  950  1=1, IIG 

NASNU348 

53/ 

J*IGNORE (I) 

NASNU349 

538 

IF(J.LE.O)  GO  TO  950 

NASNU350 

539 

K=K*  1 

NASNU351 

540 

INT  (K ) = J 

NASNU352 

541 

IF(K.GE. MAXGRD)  CALL  FIXIT(INT,K) 

NASNU353 

542 

950  CONTINUE 

NASNU354 

543 

c 

K=NUMRER  OF  POINTS  TO  BE  IGNORED  BEFORE  COMPRESSING  LIST. 

NASNU355 

544 

960  IF(K.LE.O)  GO  TO  970 

NASNU356 

545 

c 

OELETE  POINTS  LISTED  IN  INT  ARRAY  FROM  CONNECTION  TABLE  IG. 

NASNU357 

546 

CALL  MORRIS (INT, K, IG,  III) 

NASNU358 

547 

970  CONTINUE 

N ASNU359 

548 

c 

RENUMBER  NODES  WITH  SUBROUTINE  SCHEME. 

NASNU360 

549 

IF(IPAPAMUQ)  .EQ.6)  IARG(5)  =  1 

NASNU361 

550 

118=113/2 

NASNU362 

551 

CALL  SECOND ( T I Ml ) 

NASNU363 

552 

CALL  SCHEME (IARG(l) ,IARG(2), IARG(3) ,IARG(4), IARG(5) ,IG,II1, 

NASNU364 

553 

♦  JNV( 1) , JNV(II8*1) , JNV(2*II8+1) , JNV(3*II8tl) , INT , ICC , I L D, IP ) 

NASNU365 

554 

CALL  SEC ONO ( TIM2) 

NASNU366 

555 

TIM2=TIM2*TIM1 

NASNU367 

556 

IF ( IPARA.i(lO)  .EQ.5)  GO  To  580 

NASNU368 

557 

WRITE (6, 15) T I  M2 

NASNU369 

558 

WRITE (6,4) 19 

NASNU370 

559 

c 

write  new  nastpan  oata  DECK. 

NASNU371 

560 

580  READ ( 9, 9 ) 0 

NASNU372 

561 

WRITE (8,9) B 

NASNU373 

562 

IF  (B(  1)  .NE.9EGDGO  To  580 

NASNU374 

563 

590  RE  A  D ( 9  >  9 ) B 

NASNU375 

564 

IF (B(l) .GE.SEQG.OR.R(l) .EQ.ENDD) GO  TO  600 

NASNU376 

565 

HRITF  (8, 9)  B 

NASNU377 

566 

GO  TO  590 

NASNU378 

567 

c 

WRITE  SEQGP  CAROS. 

NASNU379 

568 

600  KRFM=M0D(NEW,4) 

NASNU380 

569 

IF ( NEW.GE.4)  GO  TO  605 

NASNU381 

570 

KBEG= 1 

NASNU382 

571 

GO  TO  612 

NASNU383 

572 

605  IENO=  NEW-KREH-3 

NASNU384 

573 

00  610  K= 1 , IENO , 4 

NASNU385 

574 

L=K  +  3 

NASNU386 

575 

610  WRITE(«,12)  (NORIG(I) ,IL0(I) ,I=K,L) 

NASNU387 

576 

IF ( KREM. EQ. 0) GO  TO  620 

NASNU398 

577 

KBF  G= IE  N  0*4 

NASNU389 

578 

612  DO  615  I=KeEG,NEW 

N ASNU390 

579 

615  WRITE  (8, 8)  NORIG ( I) , ILD ( I) 

NASNU391 

580 

C 

WRITE  THE  REMAINDER  OF  THE  NASTRAN  OECK. 

NASNU392 

581 

620  WRITE  (8, 9) B 

NASNU393 

582 

IF  <  fi  ( 1 ) .EQ.ENDD) GO  TO  700 

NASNU394 

583 

REA0(9,9)8 

NASNU395 

584 

GO  TO  620 

NASNU396 

585 

700  CONTINUE 

NASNU397 

586 

IF( IPARAM(IO) .EQ.5)  GO  TO  900 

NASNU398 

587 

C 

PRINT  ORIGINAL  GRID  POINT  CONNECTION  TABLE. 

NASNU399 

588 

MAXD=  MM 

NASNU40  0 

589 

L  =  HAX  D/1 1  +  1 

NASNU40 1 

590 

L=LEN/L 

NASNU402 

591 

705  FORMAT ( 1 0H1  GRID,5X,5H  MAX, 15X, 13H*C0NNECT IONS*, 5X, 

NASNU403 

592 

♦  23H (ORIGINAL  GRIO  NUMBERS)  /5X, 

NASNU404 

593 

+  20HPQINT  COMP  01  ST  DEGR  ,11(AX,1H»)  ) 

NASNU405 

594 

710  FOPMAT(I10,3I5,11I9/25(25X,UI9/)  ) 

NASNU406 

595 

00  750  1=1, NN 

NASNU40  7 

596 

IF (NO 0(1, L> . Ed . 1 )  WRITE (6,705) 

NASNU408 

597 

DO  720  J=1 , MAXO 

NASNU40  9 

598 

720  IP { J)  =0 

NASNU410 

599 

C 

CALCULATE  MOIST  ANO  PRINT  TABLE. 

NASNU411 

600 

31 


noooooooooooooonooo 


MDI ST -0 

DO  725  J  =  1 »  M AXD 

K=IUNPK(  TG, MAXGRO* ( J- 1)  ♦ I , N0 IT  IN ) 

IF(K.EQ.O)  GO  TO  725 
HDIST=MAX0  (MOIST,  IABS  U-K)  ) 

1° ( J) =NORIG ( K) 

725  CONTINUE 
K=NORIG( I) 

IP  1  =  1 NV (1,1) 

IP2  =  I NV  < MAXGRO* 1,1) 

750  WRITE (6, 710)  K, IP1, MOIST, IP2, (IP(J) ,J=1,MAXD) 

C  PRINT  CONNECTION  TABLE  FOR  RENUMBERED  NUMBERS. 

DO  780  1=1, NEW 
780  ICC (I )=ILO(I) 

CALL  SWITCHCIG, I I 1 , INT , ICC , I P ( 1) , IP < MAXOEG+1 > ) 

CALL  DEGREECIG, III, JNV ( 1 1 B ♦ 1 ) ) 

L  =  C0MPNT (IG, III, JNV(1 ) ,JNV(IIft*l> , JNV ( 3  *  1 1  8  +  1)  , ICC) 

L=H  AXD/26* 1 
L  =  L  EN/L 

805  FORMAT (37H1LABEL  COMP  MDI ST  OEGR  CONNECTIONS  ,10X, 

*  20H  ( RENUMBERE ')  NUMBERS)  ) 

810  FORMAT (516,2015/  2 5 (2 5X , 2 1 15/ >  ) 

00  850  1=1, NN 

IF ( MOD ( I ,L  >  . EQ. 1 )  WRITE(6,805) 

00  820  J=1 , MAXO 
820  IP(J)=0 

C  CALCULATE  MOIST  AND  PRINT  TABLE. 

MOI ST  =  0 

00  825  J  =  1 ,  M.A X 0 

K=IUNPK( IG, MAXGRO* (J-l) ♦I,NBITIN) 

IFCK.EG. 0)  GO  TO  825 
MDIST=MAXO(MOIST,IABS(I-K> ) 

IP  (  J  )  =K 

825  CONTINUE 

C  INV ( I , 1 ) = IC ( I)  BEFORE  PACKING 
C  INV(MAXGRD+I ,1) =IOEG(I)  BEFORE  PACKING 
IP1=INV( 1,1) 

IP2=INV(MAXGR0iI,l) 

850  HRI TE (6  »  8 1 Q )  I , I  PI , MO  I  ST , I P2 , ( IP ( J) , J=1 , M A XD ) 

900  RETURN 
END 

SUBROUTINE  FLIP(LIST  »N» INV, 1 13, ICC) 

C  CONVERT  S-ARRAY  LIST  OF  LENGTH  N  FROM  ORIGINAL  TO  INTERNAL  NUMBERS. 
COMMON  /A/  MAXGRO, MAXOEG,KMOO 
DIMENSION  LIST ( 1) ,  INV (I  13,2)  ,ICC(1) 

C  CHECK  FOP  DUPLICATE  AND  ZERO  ENTRIES  AND  REDUCE  N  IF  NECESSARY. 

CALL  FIXIT (LIST ,N) 

IF(N.Lf.O)  RETURN 
00  20  1=1, N 
J=L IS  T ( I ) 

IF(J.LE.O)  GO  TO  30 
LOG  = J-l 

10  LOC=MOO(LOC,KMOO)+1 

IF(INV(LOC,1).EQ.O)  GO  TO  30 
IF( INV(LOC, 1) .NE.J)  GO  TO  10 
K= I NV (LOC,2) 

LIST ( I) = ICC (K) 

20  CONTINUE 
RETURN 

C  ABORT  BANDIT  OUE  TO  ILLEGAL  GRID  POINT  REFERENCE  ON  J-CQNTROL  CARD. 

30  WRI TE ($,40)  J 

<♦0  FORMAT?  UH1GRID  POINT  ,U0,30M  APPEARING  ON  A  $  CARD  IS  NOT  , 

♦  25H  A  STRUCTURAL  GRID  POINT.  /13H  FATAL  ERROR.  ) 

CALL  BOMBIT(fl) 

ENO 

SUBROUTINE  GOOGAN ( KA , KB , NIN, NOUT ) 

THIS  ROUTINE  RE  AOS  A  NASTRAN  DATA  DECK  ANO  R IG HT - AO JUST S  ALL 
BULK  DATA  IN  ITS  FIELDS. 

IN  AOOITION,  THE  CALLING  ARGUMENTS  PROVIDE  THE  FOLLOHING  OPTIONS  - 
KA=1,  PROCESS  ALL  CAROS  IN  THE  NASTRAN  DATA  DECK,  OR 

=2,  PROCESS  ONLY  THOSE  CARDS  WITH  A  C  OR  G  IN  COLUMN  1, 

MPC  CAROS,  ANO  THOSE  CONTINUATION  CAROS  WITH  ALL 
NUMERIC  FIELDS.  THE  ENDDATA  CARD  IS  WRITTEN  IN  ANY  CASE 
KB  =  1,  CONVERT  ALL  8  COLUMN  FIELDS  TO  16  COLUMN  FIELDS,  OR 
=  2,  THE  FIELD  WIDTHS  REMAIN  UNCHANGED. 

NIN  =  THE  LOGICAL  UNIT  FROM  WHICH  THE  INPUT  DECK  IS  READ. 

NOUT  =  THE  LOGICAL  UNIT  ON  WHICH  THE  OUTPUT  IS  WRITTEN. 

NEITHER  NIN  NOR  NOUT  ARE  REWOUND  IN  THIS  ROUTINE. 

IF  AN  ASTERISK  APPEARS  IN  FIELD  1  AFTER  THE  MNEMONIC,  IT  IS  LEFT- 

aojusteo  against  the  mnemonic. 

THE  FOLLOWING  TWO  (2>  CAROS  ARE  REQUIREO  IN  THE  DATA  DECK  - 

(1)  A  BEGIN  BULK  CARO  TO  INDICATE  THE  BEGINNING  OF  THE 
BULK  DATA  DECK,  AND 

(2)  AN  ENOOATA  CARD  TO  INDICATE  THE  ENO  OF  THE  DATA  DECK, 

ALL  CAROS  PRECEDING  THE  BEGIN  BULK  CARD  ARE  WRITTEN  ON  NOUT  IFF  KA=1. 

OIMENSION  ANUM (10) 

COMMON  A  (8Q)  ,  IP(40) 

COMMON  I  A, IB,ICARO,IFLAG,J,JNB,L,HKHOLO,MKINSR,NKNIN 
COHMON  NBLANK,NFIELO,I, ICOL, IF  IE LO , I PRO C , IT YPE 
COMMON  K,KAST ,KBLK,MKI , MKJ ,NCOL,NIP ,NN 
COMMON  /A/  MAXGRO, MAXDEG,KMOO, NMPC 
COHMON  / 3/  IPARAM(20> ,IARG(5) 

COMMON  /OOL/  ISTART (100 ) , IGNORE? 100)  »IFIRST(  100 ) 

COMMON  /DOLL/  I  DIM , 1ST A , I IG, IF IR , IGOEG, I  SC H 
COMMON  /NG/  NGRIO 
REAL  M,N,II,LL, JJ»  KK 
INTEGER  EOF 

C  DATA  CAROS  FOR  ALPHABET  (ALLOWS  FOR  FUTURE  ADDITIONS  TO 
C  USER  OPTION  LIST) . 

DATA  B,C,0,E,G,M,N,P/1HB,1HC»1H0,1HE , 1HG , 1 HM» 1HN , 1H P/ 


NASNU412 

601 

NASNU413 

602 

NASNU414 

603 

NASNU415 

604 

NASNU416 

605 

NASNU417 

606 

NASNU418 

bOi 

N A  SnU  41 9 

608 

NASNU420 

609 

NASNU421 

610 

NASNU422 

611 

NASNU423 

612 

NASNU424 

613 

NASNU425 

614 

NASNU426 

615 

NASNU427 

616 

NASNU428 

617 

NASNU429 

618 

NASNU430 

619 

NASNU431 

620 

NASNU432 

621 

NASNU433 

622 

NASNU434 

623 

NASNU435 

624 

N ASNU436 

625 

NASNU437 

62  6 

NASNU438 

627 

N ASNU439 

628 

NASNU440 

629 

NASNU441 

630 

NASNU442 

631 

NASNU443 

632 

NASNU444 

633 

NASNU445 

634 

NASNU446 

635 

NASNU447 

636 

N ASNU448 

637 

NASNU449 

630 

NASNU450 

639 

NASNU451 

640 

NASNU452 

641 

FLIP  2 

642 

FLIP  3 

643 

FLIP  4 

644 

FLIP  5 

645 

FLIP  6 

646 

FLIP  7 

647 

FLIP  0 

648 

FLIP  9 

649 

FLIP  10 

650 

FLIP  11 

651 

FLIP  12 

652 

FLIP  13 

653 

FLIP  14 

654 

FLIP  15 

655 

FLIP  16 

656 

FLIP  17 

657 

FLIP  18 

658 

FLIP  19 

659 

FLIP  20 

660 

FLIP  21 

661 

FLIP  22 

662 

FLIP  23 

663 

FLIP  24 

664 

FLIP  25 

665 

GOOGAN  2 

666 

GOOGAN  3 

667 

GOOGAN  4 

668 

GOOGAN  5 

669 

GOOGAN  6 

670 

GOOGAN  7 

671 

GOOGAN  8 

672 

.GOOGAN  9 

673 

GOOGANIO 

674 

GOOGANU 

675 

GOOGAN12 

676 

GOOGAN13 

677 

GOOGANU 

678 

GOOGAN15 

679 

G00GAN16 

680 

G00GAN17 

681 

GOOGAN 1 8 

682 

GOOGANl 9 

683 

GOOGAN20 

684 

GOOGAN21 

665 

GOOGAN22 

686 

G00GAN23 

687 

G00GAN24 

688 

G00GAN25 

689 

G00GAN26 

690 

G00GAN27 

691 

G00GAN28 

692 

GOOGAN29 

693 

GOOGAN30 

694 

G00GAN31 

695 

G00GAN32 

696 

GOOGAN33 

697 

GOOGAN34 

698 

GOOGAN3S 

699 

GOOGAN36 

700 

32 


DATA  AA,II,LL,0,R/lHAf IHI,1HL» 1H0,1HR/ 

G00GAN37 

701 

OAT A  Q,S,T,U,Y/1HQ,1HS,1HT,1HU,1HY/ 

G00GAN38 

702 

DATA  F,H, JJ.KK/1HF, 1HH, 1HJ,1HK/ 

G00GAN39 

703 

DATA  V»W,X,Z/1HV,1HW, 1MX,1HZ/ 

GOOGAN40 

704 

DATA  ASTER, PLUS, BLANK, DOLL AR/ 1 H* , 1H ♦ , 1H  ,1H|/ 

G00GAN41 

705 

DATA  ANUM/1H0 ,iHl,lH2,lH3,lH4,lH5,lH6.,tH7»lM8»lH9/ 

G00GAN42 

706 

DATA  LFLAG/0/ 

G00GAN43 

707 

OATA  IP0H8, IROM/O, 0/ 

G00GAN44 

708 

LFL AG=LFLAG*1 

G00GAN45 

709 

9  FORHATUH1) 

G00GAN46 

710 

10  FORMA T ( 8 0A1 ) 

GOOGAN47 

711 

11  F0RMAT<6A1,4<8X,8A1) , 3H*XZ , I 5/ 3H*XZ , 15, 4 < 8X, 8A1 > ,8A1) 

G00GAN48 

712 

ICARD=0 

G00GAN49 

713 

MKINSR=12 

GOOGAN50 

714 

MKNIN=NIN 

G00GAN51 

715 

C  RE  AO  EXECUTIVE  OR  CASE  CONTROL  CARO. 

G00GAN52 

716 

20  READ ( NIN , 10) A 

G00GAN53 

717 

IF(E0F<NIN) . EQ. 0 ) GO  TO  21 

G00GAN54 

718 

IF<NIN.EQ.M<NIN)CALL  90MBI T ( 1 ) 

G00GAN55 

719 

MKHOLO=NIN 

G00GAN56 

720 

NIN=MKINSR 

G00GAN57 

721 

MKINSR=MKHOLO 

G00GAN58 

722 

GO  TO  20 

G00GAN59 

723 

21  IFLAG=0 

GOOGAN60 

724 

ICARO=ICARO*1 

G00GAN61 

725 

C  PROCESS  OUTPUT  OPTION  CARO,  IF  PRESENT. 

G00GAN62 

726 

IF (A( l) .NE.OOLLAR>GO  TO  26 

G00GAN63 

7  27 

IF(LFLAG.GT.l)  GO  TO  29 

G00GAN64 

728 

C  LOOK  FOR  FIRST  KEYWORO. 

G00GAN65 

729 

ITTPE=0 

G00GAN66 

730 

IF  ( A  (  2 ) .EQ.P.ANO.AC3) .EQ.U) ITYPE=1 

G00GAN67 

731 

IFCA<2).EQ.M.ANO.A<3) .EQ.P) ITYPE=4 

G00GAN68 

732 

IF  (A<2>  .EQ.S.  AN0.M3) .EQ.E) ITyPE=5 

G00GAN69 

733 

IF<A<2)  .EQ.R.ANO.AO)  .EQ.II)  ITYPE=6 

GOOGANZO 

734 

IF (A (2). EQ.N.ANO.A (3) .EQ.AA) ITYPE=8 

G00GAN71 

735 

IF(A(2). EQ.P. AND. A(3) . EQ. R) ITYPE=10 

GOOGAN72 

736 

IF<  A(2)  .EQ.S.ANO.A  (3)  .EQ.OGO  TO  1100 

G00GAN73 

737 

IF (A ( 2) . EQ. S.AND.A (3) . EQ.T)  GO  TO  1200 

G00GAN74 

738 

IF(A(2).EQ.O.ANO.A(3) .EQ.E)  GO  TO  1250 

G00GAN75 

739 

IF<A<2) .EQ.F.ANO.A<3> .EQ.II)  GO  TO  1300 

G00GAN76 

740 

IF(A<2),EQ. II. AND. A(3> .EQ.G)  GOTO  1350 

GOOGAN77 

741 

IF(A(2).EQ.G.ANO.A(3) . EQ. R)  GO  TO  1380 

GOOGAN7  8 

742 

IF(A(2) .EU. AA.ANO.A<3) .EQ.T)  ITYPE=12 

GOOGAN79 

743 

IF<A<2) . Fa. H. AND. A (3) .EQ.AA)  ITYPE=13 

GOOGANSO 

744 

IF(A(2) .NE. II. OR. A<3> .NE.N)GO  To  1025 

GOOGAN81 

745 

C  INSERT  CARDS  FROM  ALTERNATE  FILE 

G00GAN82 

746 

IPARAM(11)=1 

G00GAN83 

747 

MKHOL  D=N IN 

G00GAN84 

748 

NIN=HKINSR 

G00GAN85 

749 

MKINSR=MKHOLO 

G00GAN86 

750 

DO  1021  NKI  =  2 »  8 0 

G00GAN87 

751 

MKJ=81-MKI 

G00GAN88 

752 

1021  A(MKJ*1> =A<MKJ) 

G00GAN89 

753 

IPARAM(6)=4 

GOOGAN90 

754 

1025  IF ( IT YPE  «EQ. 0) GO  TO  26 

GOOGAN91 

755 

C  LOOK  FOR  SECOND  KEYWORO. 

G00GAN92 

756 

1  =  3 

G00GAN93 

757 

22  1=1*1 

G00GAN94 

758 

IF  U.  GE  •  T9)  GO  TO  26 

G00GAN95 

759 

IF (AC  I) . NE. 8LANK)G0  To  22 

G00GAN96 

760 

24  1=1*1 

G00GAN97 

761 

IF ( I. GE. 90 ) GO  TO  26 

G00GAN98 

762 

IFCA(  I) ,EQ.8LANK)G0  TO  24 

G00GAN99 

763 

J=0 

GOOGAIQ  0 

764 

IF (A(I).EQ.S.ANO.A (1*1) .EQ.E) J=1 

GOOGAlOl 

765 

IF(A(I) .EQ. AA.AND.A(I*1) .EQ.LL)J=2 

G00GA1Q2 

766 

IF  C  ft  < I) . EQ.N.ANO.A (1*1) .EQ.O) J  =  3 

GOOGA103 

767 

IF  <  A  { I )  .EQ.Y.ANO.AU*l)  .EQ.E)  J=4 

GOOGA104 

766 

IF  « ft ( I) .EQ.M.ANO.A<I*l) .EQ.II)  J=5 

GOOGAIO  5 

769 

IF(A( I) .EQ.M.ANO.A(I*l) .EQ.AA)  J=6 

GO0GA106 

770 

IF(J. EQ.OGO  TO  26 

GOOGA107 

771 

C  SET  PARAMETER. 

GOOGA108 

772 

IPARAKITYPE)  =  J 

GOOGA109 

773 

GO  TO  26 

GOOGAUO 

774 

C  RE  AO  {SCHEME  CARD. 

GOOGA111 

775 

1100  CALL  REAOIT(A,IP,NIP) 

G00GA112 

776 

ISCH= 1 

GOOGAll 3 

777 

I=MIN0 (NIP, 5) 

G00GAU4 

778 

IF(I.EQ.O)  GO  TO  29 

G00GAU5 

779 

OO  1110  J=1,I 

GOOGA 116 

780 

1110  IARG ( J) = IP( J) 

GOOGA117 

781 

GO  TO  29 

GQOGA118 

782 

C  READ  {START  CARO. 

G00GAU9 

783 

1200  CALL  REAOlT<A,IP»NIP) 

G00GA12Q 

784 

I=IST  A 

G00GA121 

785 

1ST  A* 1ST  A*NIP 

GOOGA 122 

786 

IF(ISTA.LE.IDIM)  GO  To  1205 

G00GA123 

787 

IB0M=2 

G00GA124 

788 

1ST  A= IOI M 

G00GA125 

789 

GO  TO  29 

GOOGA 126 

790 

1205  00  1210  J=i , NIP 

GOOGA127 

791 

1210  ISTART(I*J)=IP( J) 

GOOGA 128 

792 

GO  TO  29 

G00GA129 

793 

C  READ  {DEGREE  CARO. 

GOOGA13Q 

794 

1250  CALL  READIT (A, IP, NIP) 

GOOGA 131 

795 

IGDEG=IP(1) 

G00GA132 

796 

GO  TO  29 

G00GA133 

797 

C  READ  {FIRST  CARO, 

G00GA134 

798 

1300  CALL  READIT (A, IP, NIP) 

G00GA135 

799 

I=IFIR 

G00GA136 

800 

S3 


IF  I  R= IFIRfNIP 

GOOGA137 

801 

IF(IFIR.LE.IOIM)  GO  TO  1308 

GOOGA13  8 

602 

I0OM*  2 

GOOGA139 

603 

IFIR=I0IM 

GOOGA140 

804 

GO  TO  29 

GOO  G A  1 4 1 

805 

1308  DO  1310  J=1,NIP 

G00GA142 

806 

1310  IFIRST (I *J) =IP ( J) 

GOO  GA 143 

607 

GO  TO  29 

G00GA144 

606 

c  read  {ignore  card. 

G00GA145 

609 

1350  CALL  REAOIT (A, IP,NIP) 

G00GA146 

610 

1=  I IG 

G00GA147 

811 

IIG=IIG+NIP 

GOO  GA 148 

812 

IF(IIG.LE.IOIH)  GO  To  1360 

G00GA149 

613 

I0OM  =  2 

GOO  G A  15  0 

614 

IIG=I OIH 

GOOGA151 

615 

GO  TO  29 

G00GA152 

616 

1360  00  1365  J= 1 , N IP 

G00GA153 

817 

1365  IGNORE! I+J)=IP(J) 

G00GA154 

616 

GO  TO  29 

G00GA155 

819 

C  RE  AO  JGRIO  CARD. 

G00GA156 

620 

1380  CALL  REAOIT (A, IP,NIP) 

G00GA157 

821 

NGR IO  =  IP ( 1 ) 

G00GA158 

822 

GO  TO  29 

G00GA159 

623 

C  LOOK  FOR  BEGIN  BULK  CARO. 

G00GA16Q 

824 

26  1=0 

G00GA161 

625 

27  1=1+1 

GOOGA162 

626 

IFCI.GT. 75) GO  TO  29 

G00GA163 

627 

IF  <  ft  f I) .EQ.BLANK)GO  TO  27 

GOO  G A  164 

626 

IF  <  A ! I) . NF.8) GO  TO  29 

G00GA165 

829 

IF ( A ( 1+ 1 ) ,NE .E) GO  TO  29 

GOOGA166 

630 

IF (AC  1  +  2) .NE.G) GO  TO  29 

G00GA167 

631 

IF  (  A  { I  +3  )  .NE.IIJGO  TO  29 

G00GA166 

832 

IFL  AG  =  1 

GOOGA169 

833 

C  LEFT-AOJUST  BEGIN  BULK  CARO. 

GOO  G A 17  0 

834 

K=  7  3-  I 

GOOGA171 

835 

DO  28  J= lf  7  2 

GOOGA172 

836 

IF (J.LE.K)A (J)=A!J+I-1) 

GOOGA173 

837 

28  IF(J.GT.K)A(J)=BLANK 

G00GA174 

838 

IFCLFLAG.GT .1)  GO  TO  29 

GOOGA175 

839 

C  REJECT  ILLEGAL  PARAMETERS  AND  SET  TO  DEFAULTS. 

GOOG A  1 7  6 

840 

IF  (  IPARAHtl)  .  NE  .  2  .  AND.  I  PAR  AM  (D.NF.3)  I  PAR  AM  (1  )  =  1 

GOOGA177 

841 

DO  1450  1=2,9 

GOOG A  1 7  8 

84? 

1450  IF (IPARAM(I) .NL.4)  IPARAM(I)=3 

GOOGA179 

843 

IF ( IPARAM(IO) • NE .6)  IPARAM(10)=5 

GOOGA180 

844 

IF< IPARAM(12) .NE.3)  IPARAM<12)=4 

GOOGA181 

845 

IF ( IPARAM(13) . NE . 4 )  IPARAM!13)=3 

GOOG A 1 8  2 

846 

CALL  GRI 0 ( NGR ID ) 

GOOGA183 

847 

i=ista+iig+ifir*isch+igoeg 

GOOG  A  1 8  4 

848 

IF(I.LF.O)  GO  TO  29 

GOOG A  185 

849 

C  CHECK  FOR  ILLEGAL  SCHEME  ARGUMENTS. 

GOOG  A  1 86 

850 

00  1460  1=1,3 

GOOGA187 

851 

1460  IF ( IARG(T) .LT.l,OR.IARG< I) .GT.MAXGRO)  IBOM0=1 

GOOGA188 

852 

IF (IARG(4) ,LT.2.0R.IARG(4) .GT.3)  IB0HB=1 

G00GA189 

053 

IF!IARG!5) .LT.O.OR.IARG (5) .GT. 1)  I0OMB=1 

GOOG  A  19  0 

854 

WRITE  (6,  9) 

G00GA191 

855 

IF ( ISCH.GT. 0)  WRITE(6,1500)  ( I ARG ( I )  ,1=1,5) 

G00GA192 

856 

1500  FORMA  T  !  // »  9H  {SCHEME  ,  1  0 1  10/  20  0  (  9X ,  1 01  1  0/ )  ) 

GOOG  A  193 

857 

IF(ISTA.GT.O)  WRITE(6,1  505)  !  I  ST  A  RT  <  I )  ,  1=  1  ,  I  ST  A  > 

G00GA194 

858 

1505  FORMAT!//, 9H  {START  , 1 0 I 1 0/ 20 0 ! 9X , 1 0 I 1 0 / ) ) 

GOOGA195 

859 

IF(IGDEG.GT.O)  WRI TE ( 6, 1510)  I  GO EG 

GOOGA196 

860 

1510  FORMAT!//, 9H  {DEGREE  , 1 0 I 1 0/ 20 0 ( 9 X , 1 0 I 1 0/ ) ) 

GOOG A 197 

661 

IF! IFIR.GT. 0)  WRITE (6 , 1515)  ( I  FIRST (I) , I  =  1 , 1  FIR ) 

GOOG A  1 9  8 

862 

1515  FORMAT!//, 9H  IFIRST  ,  1  0  1  1  0/ 20  0  (  9X  ,  1  0  1 1  0  /  )  > 

G00GA199 

063 

IFCIIG.GT.O)  WRITE !6, 1520 )  ( I G NO RE ( I ) , I = 1 , I I G) 

GOOG  A2  0  0 

864 

1520  FORMAT!//, 9H  {IGNORE  , 1 0 I 1 0/ 20 0 ( 9 X , 1 0 I 1 0 / ) ) 

GOOGA201 

865 

IF  I  IB  OMB . EO . 1 )  CALL  90M3IT!4) 

GOOGA202 

866 

IF  I  I  ROM • EQ. 2 )  CALL  BOMB  IT (9) 

GOOGA  2  0  3 

867 

29  IFIKA.EQ.l) WRITE (NOUT , 10) A 

GOOGA204 

868 

IF!  IFLAG.EO. 0) GO  TO  20 

GOOG A  2  0  5 

869 

C  RfTUPN  IF  RIGHT-ADJUSTING  OF  CARDS  IS  NOT  NEEOEO . 

GOOGA206 

870 

IF! IP ARAM(5) . E Q . 3 . ANO . I  PA R AM ( 6 > . EQ. 3) RETURN 

GOOG A  2  0  7 

871 

C  READ  BULK  DATA  CARD. 

GOOGA  2  08 

872 

30  READ! NIN,10) A 

GOOG A2  0  9 

873 

IF!EOF!NIN)  . c U . 0 ) G 0  TO  31 

GOOG A  2 1 0 

874 

IF (NIN.EQ.MKNlN)  CALL  B0M3IT ( 1 ) 

G00GA21 1 

875 

c  switch  input  files 

GOOGA  212 

876 

MKHOL  0=  N 1 N 

GOOGA  2 1 3 

877 

NIN=MKINSR 

GOOG A  2 14 

878 

mkinsr=mkhold 

GOOG  A2 1 5 

879 

GO  TO  30 

GOOGA  21 6 

680 

31  ICARD=ICARD*1 

G00GA217 

881 

C  LEFT-AOJUST  FIRST  FIELD. 

G00GA21  8 

882 

DO  1600  1=1,8 

G00GA219 

883 

IF (A ! I) .NE. BLANK)  GO  TO  1610 

GOOGA  22  0 

884 

1600  CONTINUE 

G00GA221 

885 

GO  TO  30 

G00GA222 

886 

1610  IF! I. EO. 1)  GO  TO  1650 

GOOGA223 

887 

J=I-1 

GOOG  A  22  4 

888 

K=  8- J 

G00GA225 

889 

DO  1620  1=1, K 

G00GA226 

890 

A (I)=A!I+J) 

G00GA227 

891 

1620  A!I+J)=BLANK 

G00GA228 

892 

1650  CONTINUE 

G00GA229 

893 

C  LOOK  FOR  SEQGP  CARD. 

GOOGA230 

894 

IF! A! 1) .EQ.S. AND.A!2) .EQ.E.ANO.A (3) . EQ. Q . AND .A ( 4) .EQ.G) IPARAm !7 ) 

=4G00GA23l 

895 

C  LOOK  FOR  COMMENT  CARD. 

GOOGA232 

896 

IF (A! 1) . EQ. OOLLAR. AND.KA.EQ. l)GO  TO  35 

G00GA23 3 

897 

C  LOOK  FOR  ENOOATA  CARD, 

G00GA234 

898 

1=0 

G00GA23  5 

899 

32  1=1+1 

G00GA236 

900 

34 


IF ( I .GT • 75) GO  TO  35 

G00GA237 

901 

XF(A( I) *EQ« BLANK) GO  To  32 

G00GA238 

902 

IF  ( A ( I) • NE. E) GO  TO  40 

GOOGA239 

903 

IF(A(I*l).NE.N)GO  TO  40 

GOOGA240 

904 

IF(A(I*2) .NE.O)GO  To  40 

G00GA241 

905 

IF ( A { 1*3) .NE . D ) GO  TO  40 

G00GA242 

906 

c 

left-adjust  enooata  card. 

G00GA243 

90/ 

K*73- I 

G00GA244 

908 

DO  33  J= 1» 72 

G00GA245 

909 

IF(J.LE.<)A(J)*A(J*I-1> 

GOO  G A  246 

910 

33  IF(J.GT.K)A(J)*BLANK 

G00GA247 

911 

WRITE ( NOUT » 10 ) A 

G00GA248 

912 

RETURN 

G00GA249 

913 

35  WRITE (NOUT, 10) A 

GOOGA250 

914 

GO  TO  30 

G00GA251 

915 

c 

OETE RHINE  IF  CARO  IS  TO  BE  PROCESSED. 

G00GA252 

916 

40  IF(KA.EQ.l) GO  TO  150 

G00GA253 

917 

IF(A(l).EQ.C.OR.A(l).EQ.G)GO  TO  150 

G00GA254 

918 

IF(A(1) ,EQ.H.AND.A(2> ,EQ.P)GO  TO  150 

GOOGA255 

919 

NCOL=8 

G00GA256 

920 

IF(A( 1) .EQ. ASTER)GO  TO  50 

GOOGA257 

921 

IF(A(1) . EQ. PLUS) GO  TO  60 

G00GA258 

922 

GO  TO  30 

G00GA259 

923 

50  NCOL  = 16 

GOOGA260 

924 

60  NFIELD=64/NC0L 

G00GA261 

925 

1*0 

G00GA262 

926 

70  1*1*1 

G00GA263 

927 

IF(I.GT.NFIELO)GO  TO  150 

G00GA264 

928 

IPROC=0 

G00GA265 

929 

IFLAG=0 

G00GA266 

930 

J=  0 

GOOGA267 

931 

80  J=J*1 

G00GA268 

932 

IF ( IPROC .EG. 1) GO  TO  70 

G00GA269 

933 

IF  (  J.LE.NCODGO  TO  90 

GOOGA270 

934 

IF ( IFLAG .EG • 1 ) GO  To  30 

G00GA271 

935 

GO  TO  70 

G00GA272 

936 

90  IC0L=8*NC0LMI-1)*J 

G00GA273 

937 

IF ( A ( ICOL) . EQ. BLANK) GO  To  80 

G00GA274 

936 

IFL  AG  =  1 

G006A275 

939 

DO  100  L=l,10 

G00'GA276 

940 

10  0  IF(A( ICOL) .EQ.ANUN(L)  1  IPROC* 1 

G00GA277 

941 

GO  TO  80 

G00GA278 

942 

c 

PROCESS  FIRST  FIELD. 

G00GA279 

943 

150  NCOL=8 

GOOGA28Q 

944 

KAST=8 

G00GA281 

945 

KBLK=6 

G00GA282 

946 

DO  160  1=1,8 

G00GA283 

947 

IF(A(I) .NE. BLANK. A  NO. A ( I ) . NE . A STER. ANO. A <1 *1 ) . EQ. BL ANK ) KBLK = I *1 

G00GA284 

948 

IF(A(I) ,EQ.ASTER)KAST=I 

G00GA285 

949 

160  IF(A(I) ,EQ.ASTER)NC0L=16 

G00GA286 

95  0 

IF(A(l).EQ.PLUS)NCOL=8 

G00GA287 

951 

IF ( NCOL • EQ. 16) GO  TO  170 

G00GA288 

952 

IF ( KB .EQ.2) GO  TO  200 

G00GA289 

953 

IF ( A  < 1 ) .NE.PLUS) A(KBLK)=ASTER 

G00GA29Q 

954 

IF ( A ( 1 ) . EQ. PLUS ) A(1)=ASTER 

G00GA291 

955 

GO  TO  200 

G00GA292 

956 

170  IF(A(1) .EQ.ASTER)GO  TO  200 

G00GA293 

957 

IA=MINO(KAST,KBLK) 

G00GA294 

958 

IB=HAX0 (KAST,KBLK) 

G00GA295 

959 

A( IB) =8L ANK 

G00GA296 

960 

A ( I  A) sASTER 

G00GA297 

961 

c 

RIGHT-ADJUST  ALL  BULK  DATA  WHICH  IS  TO  BE  PROCESSED. 

G00GA298 

962 

200  NFIEL 0=64/NC0L 

GOOGA299 

963 

IFI ELD=0 

GOOGA3QO 

964 

210  IFIELO=IFIELO*l 

GOOGA30 1 

965 

IF( IFIELO.GT.NFIELQJGO  TO  300 

GOOGA302 

966 

1=0 

GOOGA303 

967 

220  1=1*1 

GOOGA304 

966 

IF (I. GT. NCOL) GO  TO  210 

GOOGA305 

969 

IC0L=9*NC0L*IFIEL0-I 

GOOGA30  6 

970 

IF<  A<  ICOL)  .EQ.BLANK)GO  TO  220- 

GODGA307 

971 

N8L ANK=I-1 

GOOGA308 

972 

nn=ncol-nblank 

GOOGA309 

973 

DO  230  1=1, NCOL 

GOOGA310 

974 

J=9*NC0L*IFIEL0-I 

G00GA311 

975 

JNB=J-NBLANK 

G00GA312 

976 

IF(I.LE.NN) A ( J) =A( JN9> 

GOOGA313 

977 

IFd.GT.NN)  A(J)=BLANK 

G00GA314 

978 

230  CONTINUE 

G00GA315 

979 

GO  TO  210 

G00GA316 

960 

c 

WRITE  NEW  CARO. 

G00GA317 

961 

300  IF(KB.EQ.l)  A(73)=ASTER 

GOOGA31 8 

982 

IF(NC0L.EQ.8.AN0.KB.EQ.1)G0  TO  310 

G00GA319 

983 

WRlTE(NOUT, 10)A 

GOOGA320 

984 

GO  TO  30 

G00GA321 

985 

310  WRITE (NOUT, 11) ( A { I ) , 1=1 , 40 ) , ICARD, ICARO , ( A ( I ) , 1*41, 80) 

G00GA322 

986 

GO  TO  30 

GOOGA323 

987 

ENO 

G00GA324 

988 

SUBROUTINE  GRID(NGRID) 

GRID  2 

989 

c 

PARTITION  EXPANDABLE  CORE. 

GRID  3 

990 

COMMON  /BITS/  NBITIN, N9ITEX 

GRIO  4 

991 

COMMON  /A/  MAXGRD, MAXDEG 

GRID  5 

992 

COMMON  /K/  11(7) , KOR 

GRIO  6 

993 

MAX=16364 

GRID  7 

994 

N=NGRID 

GRIO  8 

995 

IF ( N. GT. 2045)  NBITIN*15 

GRID  9 

996 

IF ( N. LE. 510 )  NBITI N=1 0 

GRID  10 

997 

IF(N.LT.IQO)  N=100 

GRID  11 

998 

IF(N.GT.MAX)  GO  TO  40 

GRID  12 

999 

c 

CALCULATE  WIDTH  11(2)  OF  IG  MATRIX. 

GRIO  13 

1000 

38 


20 


20  L=60/NBITIN 

GRID  14 

1001 

M=  6  0/ NB I  TEX 

GRID  15 

1002 

N=N+L*M-1 

GRID  16 

1003 

N=  N-MOD ( N, L+M) 

GRID  17 

1004 

MAXGRD=N 

GRID  10 

1005 

C  I  =P ACKED  LENGTH  FOR  INTERNAL  NUMBER. 

GRID  19 

1006 

C  J  =  P AC KED  LENGTH  FOR  ORIGINAL  NUMBER. 

GRID  20 

1007 

I  =  N/L 

GRID  21 

1008 

J=N/M 

GRID  22 

1009 

C  SET  UP  OIHENSIONS  IN  II  SPRAY,  WHERE  IG ( 1 1 1 , 1 1 2) , IN V (I I 3 , 2)  , 

GRID  23 

1010 

C  INK  1 14),  ICC  (1 15)  ,  ILO(II6)  ,N0RIG(II7> 

GRID  24 

1011 

II  ( 1) =1 

GRID  25 

1012 

11(3) =2* J 

GRID  26 

1013 

11(4) -J 

GRID  27 

1014 

11(5) =J 

GRID  28 

1015 

11(6) =  J 

GRID  29 

1016 

1 1  (  7 )  =  J 

GRID  30 

1017 

1=2*11  (3)4lI(4)+II (5) ♦II(6)  +  II  (7) 

GRID  31 

1018 

I I ( 2) = ( KOR- I) /(II(1)42) 

GRID  32 

1019 

C  DENOMINATOR  CONTAINS  A  2  TO  ALLOW  FOR  2  SCRATCH  ARR AYS,  EACH 

OF 

GRIO  33 

1020 

C  LENGTH  MAXDEG. 

GRID  34 

1021 

11(2) =M I  NO (11(2)  , N-l ) 

GRID  35 

1022 

MA  X  DEG  =  I I (2 ) 

GRID  36 

1023 

RETURN 

GRIO  37 

1024 

C  SUBSTITUTE  MAX  IF  NGRID  TOO  LARGE. 

GRIO  38 

1025 

40  N=M  A  X  - 

GRID  39 

1026 

WRITE(6,50)  NGRID, N 

GRID  40 

1027 

50  FORMAT (23H1BANOIT  WARNING  MESSAGE/ 1 0 X, 6HJGRI D  ,I10,5X, 

GRID  41 

1028 

4  9H  TOO  LARGE  /10X,6HJGRID  , 1 10 , 5X , 12HSU 8ST I  TUT  ED .  ) 

GRIO  42 

1029 

GO  TO  20 

GRID  43 

1030 

END 

GRID  44 

1031 

SUBROUTINE  RE  AD IT ( A , I P, Nl P ) 

READIT  2 

1032 

C  THIS  ROUTINE  READS  AND  STORES  (IN  IP)  NUMERIC  DATA  APPEARING 

ON 

REAOIT  3 

1033 

C  J-CONTROL  CAROS  UP  TO  COLUMN  72. 

READIT  4 

1034 

DIMENSION  A NUM (10) 

REAOIT  5 

1035 

DIMENSION  A (1) , I P  C 1 ) 

READIT  6 

1036 

DATA  ANUM/1H0, 1H1, 1H2, 1H3, 1H4, 1H5 , 1H 6, 1 H7 , 1H 8, 1 H 9/ 

READIT  7 

1037 

c  initialize  ARRAY. 

READIT  8 

1038 

NI  P=  0 

READIT  9 

1039 

DO  10  1=1,40 

REAOITIO 

1040 

10  IP(I)=0 

READIT11 

1041 

1  =  3 

READIT1 2 

1042 

OO  70  KOUnT  =  1,i,0 

READIT13 

1043 

NUM  =  0 

READIT 14 

1044 

NUMFL  =0 

READIT 15 

1045 

20  1=1+1 

READIT 16 

1046 

IF ( I • LE • 72 )  GO  TO  30 

READIT 1 7 

1047 

IF ( NUMFL .EQ. 1 )  GO  TO  60 

REA0IT18 

1048 

RETURN 

READIT19 

1049 

30  K=  99 

READIT20 

1050 

DO  40  J=l,10 

READIT21 

1051 

40  IF  (  A ( I > .EQ. ANUM(J)  )  K  =  J-1 

READ1T22 

1052 

IF ( K • NE • 99 )  GO  TO  50 

READ IT23 

1053 

IF (NUMFL)  60,20,60 

READIT24 

1054 

50  NUMFL  =  1 

READIT25 

1055 

NUM  =  1 0*  NUM  +  K 

REA0IT26 

1056 

GO  TO  20 

READIT27 

1057 

60  NIP=KOUNT 

READIT28 

1058 

IP(NIP)=NUM 

READIT29 

1059 

70  CONTINUE 

READIT3  0 

1060 

NIP  =  4  0 

READIT3 1 

1061 

RETURN 

READ IT32 

1062 

END 

READIT33 

1063 

SUBROUTINE  BOMBIT ( IERR) 

BOMBIT  2 

1064 

C  BOMB  BANDIT  TO  SUPPRESS  THE  EXECUTION  OF  NASTRAN. 

BOMBIT  3 

1065 

COMMON  /B/  IPARAM(20) 

BOMBIT  4 

1066 

COMMON  /K/  11(7)  ,KORE,IFL 

BOMBIT  5 

1067 

3  FORMAT (♦ -CURRENT  FIELD  LENGTH  (FL)  =  *,06,*B*/ 

BOMBIT  6 

1068 

4  *  THIS  BANDIT  JOB  MAY  REQUIRE  A  LARGER  FIELD  LENGTH  ( FL) */ 

BOMBIT  7 

1069 

4  *-THERE  FORE ,  MAKE  THE  FOLLOWING  CHANGES*/ 

BOMBIT  8 

1070 

4  *  1.  INCREASE  THE  FL*/ 

BOMBIT  9 

1071 

4  *  2.  INSERT  A  NOREOUCE.  CARD  IMMEDIATELY  BEFORE  THE  *, 

80MBIT10 

1072 

4  *BANDIT •  CARD*/ 

BOMBIT 1 1 

1073 

+  *  3.  INSERT  A  JGRID  N  CARD  SOMEWHERE  BEFORE  THE  BEGIN*, 

BOMBIT 12 

1074 

4  *  BULK  CARD,  WHERE  THE  INTEGER  N  IS  AN  UPPER  BOUNO  (PREFERABLY*/ 

BOMBIT 1 3 

1075 

+  *  LEAST  UPPER  BOUNO)  ON  THE  NUMBER  OF  GRID  POINTS*) 

BOMB I Tl 4 

1076 

5  FORMAT(200(1H4,130X/) ) 

80MBIT15 

1077 

CALL  REMARK ( 40H  *************************************  , 

BOMBIT 16 

1078 

GO  TO  (10,20,30,40,50,60,70,80,90),  IERR 

BOMBIT 1 7 

1079 

EOF  ENCOUNTERED. 

BOM8IT18 

1080 

10  WRI TE (6,12) 

B0MBIT19 

1081 

12  FORMAT (55H1BANDIT  FATAL  ERROR  -  MISSING  BEGIN  BULK  OR 

enodata. 

}  BOMBIT20 

1082 

+  6 H  CARD.  ) 

BOMBIT  21 

1083 

CALL  REMARK ( 39H  **MISSING  BEGIN  BULK  OR  ENDDATA  CARO  ) 

BOMBIT22 

1084 

GO  TO  500 

B0MBIT23 

1085 

C  BULK  DATA  CARD  OUT  OF  SORT. 

B0MBIT24 

1086 

20  CALL  REMARK (31H  **8ULK  OATA  CARD  OUT  OF  SORT  ) 

B0MBIT25 

1087 

GO  TO  500 

B0MBIT26 

1088 

C  SEQGP  CAROS  IN  DECK  AND  RESEQUENCING  REQUESTED. 

B0MBIT2  7 

1089 

30  CALL  REMARK (3 2H  **SEQGP  CARDS  ALREADY  IN  DECK  ) 

B0MBIT28 

1090 

GO  TO  500 

B0MBIT29 

1091 

C  ISCHEME  ILLEGAL  ARGUMENTS. 

BOMBIT30 

1092 

40  WRITE (6,42) 

BOMB I T  3 1 

1093 

42  F0RMAK46H1BAN0IT  FATAL  ERROR  -  ILLEGAL  ARGUMENTS  ON, 

BOMB I T32 

1094 

4  14H  S  SCHEME  CARO.  ) 

B0MBIT33 

1095 

CALL  REMARK ( 3 0 H  **I LLEGAL  SSCHEME  ARGUMENTS  ) 

B0MBIT3  4 

1096 

GO  TO  500 

BOMBIT 3  5 

1097 

C  TOO  MANY  TERMS  IN  MPC  EQUATION. 

BOMBIT  36 

1098 

50  CALL  REMARK ( 36H  **MPC  EQUATION  HAS  TOO  MANY  TERMS  ) 

BOMBIT37 

1099 

GO  TO  500 

B0M8IT38 

1100 

36 


c 

MAXDEG  EXCEEDED . 

B0MBIT39 

1101 

60  CALL  REMARK (28H  "MAXIMUM  DEGREE  EXCEEOED  ) 

BOMBIT40 

1102 

WRITE  (6,3)  IFL 

B0MBIT41 

1103 

GO  TO  500 

B0MBIT42 

1104 

c 

MAXGRO  EXCEEDED. 

B0MBIT43 

1105 

70  CALL  REMARK ( 39H  "MAX  NUMBER  OF  GRIO  POINTS 

EXCEEDED  ) 

B0MBIT44 

1106 

WRITE (6,3)  IFL 

80MBIT45 

1107 

GO  To  500 

B0MBIT46 

1106 

c 

NON-EXISTENT  GRID  POINT  REFERENCE  ON  l-CARD 

B0MBIT47 

1109 

80  CALL  REMARK  (32H  "ILLEGAL  REFERENCE  ON 

S-CARD  ) 

B0MBXT48 

1110 

GO  TO  500 

B0MBIT49 

1111 

c 

TOO  MANY  GRID  POINTS  ON  J-CARD. 

BOMBIT50 

1112 

90  WRITF(6,92> 

B0MBIT51 

1113 

92  FORMAT (51H1BANDIT  FATAL  ERROR  -  TOO 

MANY  POINTS  ON  t-CARO) 

BOMBIT52 

1114 

CALL  REN  ARK (30H  *»TOO  HANY  POINTS  ON  S 

-CARO 

> 

BOMBIT  53 

1115 

GO  TO  500 

BOMB  I T54 

1116 

c 

ABORT  BANDIT. 

B0MBIT55 

1117 

500  CALL  REMARKU7H  "BANOIT  ABORT  ) 

B0MBIT56 

1118 

CALL  REM  ARK ( 23H  "N  AS  TRAN  SUPPRESSED  ) 

B0MBIT57 

1119 

BOMBIT58 

1120 

WRITE  (6,5) 

BOMBIT59 

1121 

CALL  ABT 

BOMBIT65 

1122 

STOP 

B0MBIT66 

1123 

END 

BOMB  I T6  7 

1124 

SUBROUTINE  SC AT ( KG , NC ON , NEW , INV, I 13, NORIG) 

SCAT  2 

1125 

c 

THIS  ROUTINE  USES  SCATTER  SORT  TECHNIQUES  FOR  EACH 

GRIO  POINT 

SCAT  3 

1126 

c 

ENCOUNTERED  TO  DETERNINE  WHETHER  OR 

hot  the  point  has 

SCAT  4 

1127 

c 

BEEN  SEEN  BEFORE.  IF  NOT,  INV,  NORIG,  AND  NEW  ARE  UPOATEO. 

SCAT  5 

1126 

c 

INV (1,1)  CONTAINS  AN  ORIGINAL  GRID  POINT  NUMBER 

SCAT  6 

1129 

c 

iNVdfZ)  contains  the  internal  nuhber  assigned  to 

IT  (BEFORE  SORTING) 

SCAT  7 

1130 

DIMENSION  INV (113,2), NO RIG(l) 

SCAT  8 

1131 

COMMON  /A/  MAXGRO, MAXOEG,KMOD 

SCAT  9 

1132 

DIMENSION  KG ( 1 ) 

SCAT  10 

1133 

OO  100  1=1 , NCON 

SCAT  11 

1134 

NOLD=KG ( I) 

SCAT  12 

1135 

IF (NOLO.EQ. 0)GO  TO  100 

SCAT  13 

1136 

LOC=NOLD-l 

SCAT  14 

1137 

10  LOC  =  MOO(LOC,KMOD)  *1 

SCAT  15 

1138 

20  IFCINV(L0C,1I  .NE.O)  GO  TO  30 

SCAT  16 

1139 

INV (LOC, l)=NOLD 

SCAT  17 

1140 

NEW=NEW*1 

SCAT  18 

1141 

IF (NEW.GT.MAXGRD)  GO  TO  150 

SCAT  19 

1142 

NORIG (NEW) =NOLD 

SCAT  20 

1143 

INV (L  OC  »  2) =NE W 

SCAT  21 

1144 

GO  TO  40 

SCAT  22 

1145 

30  IF(INVCLOC,l> .NE.NOLO)  GO  TO  10 

SCAT  23 

1146 

40  KG(I)=INV(LOC,2) 

SCAT  24 

1147 

100  CONTINUE 

SCAT  25 

1148 

return 

SCAT  26 

1149 

150  WRITE (6, 160)  MAXGRO 

SCAT  27 

1150 

160  FORMAT (35H1  THIS  STRUCTURE  CONTAINS  MORE 

THAN, 

16, 

SCAT  28 

1151 

*  1 4H  GRIO  POINTS.  /14H  FATAL  ERROR.  ) 

SCAT  29 

1152 

CALL  80M8IT (7) 

SCAT  30 

1153 

END 

SCAT  31 

1154 

SUBROUTINE  BRIGIT (IG,  m,INV>II3,INT,ICC. 

, NORIG 

,  IP) 

8RIGIT  2 

1155 

C 

THIS  ROUTINE  GENERATES  A  NEW  INTERNAL/EXTERNAL  CORRESPONDENCE 

BRIGIT  3 

1156 

C 

TABLE  NORIG  AND  CONNECTION  TABLE  IG  SUCH  THAT 

THE  NEW  INTERNAL 

BRIGIT  4 

1157 

C 

NUHBERS  CORRESPOND  TO  A  SORT  OF  THE  ORIGINAL 

NUMBERS  INTO 

BRIGIT  5 

1158 

C 

ASCENOING  OROER. 

BRIGIT  6 

1159 

C 

INPUT  -  IG, I NV, NORIG 

BRIGIT  7 

1160 

C 

OUTPUT  -  IG, NORIG, ICC 

BRIGIT  8 

1161 

C 

SCRATCH  -  INT , IP 

BRIGIT  9 

1162 

DIMENSION  IG(II1,1) ,INV(II3,2) 

BRIGIT10 

1163 

DIMENSION  INT ( 1 > , ICC ( 1 ) , NORIG (1) ,IP(1) 

BRIGIT11 

1164 

COMMON  /S/  NN, MM > IH, 1 9 

BRIGIT12 

1165 

COMMON  /A/  MAXGRO, HAXOE G, KMOD, NMPC 

0RIGIT13 

1166 

COMMON  /BITS/  MBIT  IN, NBITEX, IP  ASS 

BRIGIT14 

1167 

REWINO  8 

BRIGIT15 

1168 

c 

PERFORM  A  ROUGH  SORT  OF  THE  ORIGINAL  GRID  NUMBERS. 

BRIGIT16 

1169 

L  =  0 

BRIGIT17 

1170 

KFAC=-1 

BRIGIT18 

1171 

20  KFAC=KFAC+1 

BRIGIT19 

1172 

MIN=2 147 483647 

BRIGIT20 

1173 

OO  50  1=1, KMOD 

BRIGIT21 

1174 

IF (INV (1,1) .GT. (KF AC* KMOD) ) 

BRIGIT22 

1175 

♦  MIN=MIN0 (MIN, INV ( I, 1) ) 

BRIGIT23 

1176 

50  CONTINUE 

BRLGIT24 

1177 

KFAC=  (MIN-D/KMOD 

BRIGIT25 

1178 

DO  80  1=1, KMOD 

BRIGIT26 

1179 

IS= IN V ( I , 1) 

BR1GIT27 

1160 

IF ( IS.LE . (KFAC*KMOD) .OR. IS.GT. (KFAC ♦ 1 ) * KMOD) GO 

TO  80 

BRIGIT28 

1181 

L  =  l  ♦  1 

BRIGIT29 

1162 

INT (L)=INV(I,1) 

BRIGIT30 

1183 

80  CONTINUE 

BRIGIT31 

1184 

iftl.lt.nnigo  to  bo 

BRIGIT32 

1185 

c 

COMPLETE  THE  SORTING  OF  THE  ORIGINAL  GRIO  NUMBERS. 

BRIGIT33 

1186 

CALL  SORT< INT, NN) 

BRIGIT34 

1187 

c 

DETERMINE  CORRESPONDENCE  (ICC)  BETWEEN  NORIG 

ano  int  arrays. 

BRIGIT35 

1186 

DO  130  1=1, NN 

BRIGIT36 

1189 

L=INT  (I) 

BRIGIT37 

1190 

LOC=L-l 

BRIGIT38 

1191 

110  LOC=MOO(LOC,KMOD)+1 

BRIGIT39 

1192 

120  IF(INV(LOC,l> .NE.L)  GO  TO  110 

BRIGIT40 

1193 

M=INV  (LOC, 2) 

0RIGIT41 

1194 

ICC (M)=I 

BRIGIT42 

1195 

130  CONTINUE 

BRIGIT43 

1196 

C 

TRANSFER  INT  ARRAY  TO  NORIG  ARRAY. 

BRIGITA4 

1197 

DO  220  1=1, NN 

BRIGIT45 

1198 

220  NORIG (I)=INT(I) 

BRIGIT46 

1199 

C 

CHANGE  IG  MATRIX  ACCORDING  TO  CORRESPONDENCE 

TABLE 

ICC. 

BRIGIU7 

1200 

37 


CALL  SWITCH(IG,II1,INT, ICC,IP(1) , IP < MAXOEGd ) ) 

BRIGIT40 

1201 

REWIND  8 

8RIGIT49 

1202 

RETURN 

BRIGIT50 

1203 

END 

BRIGIT5 1 

1204 

SUBROUTINE  SORT (LIST, NL) 

SORT  2 

1205 

C  THIS  SUBROUTINE  SORTS  A  LIST  OE  LENGTH  NL  AND  IS  BIASED  TOMAROS  THOSE  SORT  3 

1206 

C  LISTS  NOT  BAOLY  OUT  OF  SORT. 

SORT  4 

1207 

DIMENSION  LlStm 

SORT  5 

1208 

IF(NL.LE.l)  RETURN 

SORT  6 

1209 

NL 1 =NL- 1 

SORT  7 

1210 

DO  20  I* If  NL 1 

SORT  8 

1211 

K=  NL  - 1 

SORT  9 

1212 

KFL  AG  =  0 

SORT  10 

1213 

DO  10  J*  1 ,  K 

SORT  11 

1214 

IF(LIST (J).LE.LIST  C  J ♦ 1 > )  GO  TO  10 

SORT  12 

1215 

KFL  AG  =1 

SORT  13 

1216 

L  =  L 1ST  ( J ) 

SORT  14 

1217 

LIST< J)=LIST( JM) 

SORT  15 

1218 

LIST ( Jf 1 ) =L 

SORT  16 

1219 

10  CONTINUE 

SORT  17 

1220 

IF(KFLAG.EQ.O)  RETURN 

SORT  18 

1221 

20  CONTINUE 

SORT  19 

1222 

RETURN 

SORT  20 

1223 

END 

SORT  21 

1224 

SUBROUTINE  SETIG (KG1 , KG2 , IG, I I 1, NORIG) 

SETIG  2 

1225 

C  THIS  ROUTINE  SETS  I G (KG1, - ) =KG2  AND  IG ( KG2 , - ) = KG  1  IF 

THIS 

SETIG  3 

1226 

C  CONNECTION  HAS  NOT  ALREADy  BEEN  SET, 

SETIG  4 

1227 

DIMENSION  IG(IIlf 1) ,NORIG(l) 

SETIG  5 

1228 

COMMON  /S/  NNfHHflHfIB 

SETIG  6 

1229 

COMMON  /A/  MAXGRD, MAXOEG, KMOD, NMPC 

SETIG  7 

1230 

COMMON  /SITS/  NBITIN, NBITEX, IPASS 

SETIG  9 

1231 

IF (KG 1.EQ.0 ) RETURN 

SETIG  9 

1232 

IF(KG2.EQ.O) RETURN 

SETIG  10 

1233 

IF ( KG 1.EQ.KG2) RETURN 

SETIG  11 

1234 

DO  50  LOOP= If? 

SETIG  12 

1235 

L  =  KG1 

SETIG  13 

1236 

K=KG2 

SETIG  14 

1237 

IF (LOOP, EQ.  1)  GO  TO  20 

SETIG  15 

1238 

L  =  KG2 

SETIG  16 

1239 

K=KG1 

SETIG  17 

1240 

20  M=  0 

SETIG  18 

1241 

30  M=M+ 1 

SETIG  19 

1242 

IF ( M. GT . MAXOEG)  GO  TO  60 

SETIG  20 

1243 

IS  = I UNPK ( IG, MAXG RD* <M- 1 ) ♦  L, NBITIN) 

SETIG  21 

1244 

IF(IS.EQ.O)  GO  TO  40 

SETIG  22 

1245 

IFUS.NE.K)  GO  TO  30 

SETIG  23 

1246 

GO  TO  50 

SETIG  24 

1247 

40  CALL  PACK(IG,HAXGR0MM-1)4-L,NBIT  IN,K) 

SETIG  25 

1248 

MM=MAX0 (MM,M) 

SETIG  26 

1249 

50  CONTINUE 

SETIG  27 

1250 

RETURN 

SETIG  28 

1251 

60  WRT  TE (6, 70)  NORIG(L) , MAXOEG 

SETIG  29 

1252 

70  FORMA  T ( 1 2H1  GRID  POINT , 112, 26H  HAS  DEGREE  GREATER  THAN, 

,16/ 

SETIG  30 

1253 

♦  1 4 H  FATAL  ERROR.  ) 

SETIG  31 

1254 

CALL  BOM  BIT (6) 

SETIG  32 

1255 

END 

SETIG  33 

1256 

SUBROUTINE  TIGER (NEQ,IG, III, LI  ST, NORIG) 

TIGER  2 

1257 

C  THIS  ROUTINE  MAKES  ADDITIONS  TO  THE  CONNECTION  TABLE 

IG  TO  REFLECT 

TIGER  3 

1258 

C  THE  presence  of  hpc's  and  stores  the  dependent  points  in 

LIST. 

TIGER  4 

1259 

C  NEQ=NUMBER  OF  MPC  EQUATIONS. 

TIGER  5 

1260 

DIMENSION  IG(IIlfl) , L 1ST ( 1 ) , NORIG (1) 

TIGER  6 

1261 

COMMON  /S/  NN, MM , IH» I B 

TIGER  7 

1262 

COMMON  /A/  MAXGRO, MAXOEG, KMOD, NMPC 

TIGER  Q 

1263 

COMMON  /BITS/  NBITIN, NBITEX, IPASS 

TIGER  9 

1264 

DIMENSION  KG ( 40 ) 

TIGER  10 

1265 

if<neo.eq.q>return 

TIGER  11 

1266 

REWIND  11 

TIGER  12 

1267 

C  INITIALIZE  LIST. 

TIGER  13 

1268 

DO  20  1=1, NN 

TIGER  14 

1269 

20  LIST ( I)  =  0 

TIGER  15 

1270 

C  GENERATE  NEW  CONNECTIONS. 

TIGER  16 

1271 

DO  100  11=1, NEQ 

TIGER  17 

1272 

READ(  11) KG 

TIGER  18 

1273 

IGRID  =KG ( 1 ) 

TIGER  19 

1274 

L 1ST ( IGR ID) = IGRID 

TIGER  20 

1275 

OO  100  1=1, MAXOEG 

TIGER  21 

1276 

L=IUNPK( IG»MAXGRO* (1-1) ♦IGRID, NBITIN) 

TIGER  22 

1277 

DO  100  J=2 , NMPC 

TIGER  23 

1278 

100  CALL  SETIG(L,KG(J) ,IG, III, NORIG) 

TIGER  24 

1279 

REWIND  11 

TIGER  25 

1200 

return 

TIGER  26 

1281 

END 

TIGER  27 

1282 

SUBROUTINE  SWITCH! IG, III , IFL AG ,KT ,KA ,KB ) 

SWITCH  2 

1283 

c  this  subroutine  generates  a  neh  ig  matrix  according  to  the 

SWITCH  3 

1284 

C  CORRESPONDENCE  TABLE  KT,  WHICH  MUST  BE  SET  UP 

SWITCH  4 

1285 

C  PRIOR  TO  THE  CALL.  ONLY  INTERNAL  NUMBERS  ARE 

ALLOWED 

SWITCH  5 

1206 

C  AS  VALUES  OF  KT. 

SWITCH  6 

1287 

C 

SWITCH  7 

1288 

C  INPUT  -  IG , KT 

SWITCH  8 

1289 

C  OUTPUT  -  IG 

switch  9 

•  1290 

C  SCRATCH  -  IFL AG , K A , KB 

SWITCH10 

1291 

C 

SWITCH11 

1292 

DIMENSION  IG(IIlfl) ,IFLAG( 1) ,KT( 1) ,KA(1) ,KB(1) 

SWI T  CHI  2 

1293 

COMMON  /S/  NN, MM , IH, I B 

SWITCH1 3 

1294 

COMMON  /A/  MAXGRD, MAXOEG, KMOD, NMPC 

SWITCH14 

1295 

COMMON  /BITS/  NBITIN, NBITEX, IPASS 

SWITCH15 

1296 

C  KT=C ORRESPONOENCE  TABLE.  KT  (OLD )  =  NEW. 

SWITCH16 

1297 

C  K  A,KB  =  TEMPORARY  STORAGE  ROWS. 

SWITCH17 

1298 

DO  100  1=1, NN 

SWITCH18 

1299 

DO  90  J= 1 , MM 

S WIT  CHI  9 

1300 

38 


L*IUNPK<IG, MAXGRO*  (J-l) ♦I.NBITIN) 

SMITCH20 

1301 

IF(L.LE.O)  GO  TO  100 

SWITCH21 

1302 

IS«KT  (L ) 

SMITCM22 

1303 

CALL  PACK(IG,NAXGRO*C J-1)»I,N0ITIN,  IS) 

SWITCH23 

1304 

90  CONTINUE 

SWITCH24 

1305 

100  CONTINUE 

SWITCH25 

1306 

C  INITIALIZE  FLAGS. 

SWITCH26 

1307 

00  120  1*1, NN 

SWITCH27 

1308 

120  IFL  AG  < I ) *0 

SWITCH28 

1309 

C  INITIALIZE  TEMPORARY  STORAGE  ROWS. 

S WITCH29 

1310 

DO  130  1*1, HM 

SWITCH30 

1311 

KA(I>*0 

SWITCH31 

1312 

130  KBIZMO 

SHITCHJ2 

1313 

C  RE-ORDER  ROWS  OF  IG  MATRIX. 

SWITCM33 

1314 

00  200  IROW=l,NN 

SWITCH34 

1315 

IF(IFLAGCIROW) .EQ.l)  GO  TO  200 

SWITCH35 

1316 

IFCKT IIROW) .EQ. IROW)  GO  TO  200 

SHITCH36 

1317 

IFL  AG  (IROW) =1 

SWITCH37 

1318 

00  140 

SWITCH38 

1319 

140  KB  (J)=IUNPK(IG,MAXGR0* ( J-l) ♦IROW, NBITIN) 

SWITCH39 

1320 

L*KT ( IROW) 

SWXTCH40 

1321 

150  IFLAG  (L) =1 

SWITCH41 

1322 

DO  160  J=1,MM 

SWITCH42 

1323 

KA<  J)  sIUNPKUG,  MAX  GROM  J- 1) *L , N8 ITI N > 

SHITCH43 

1324 

CALL  PACK(IG,MAXGR0*(J-1)*L,N8ITIN,K6(J) > 

SWITCH44 

1325 

160  KB(J)=KA(J> 

SWITCH45 

1326 

H*KT ( L) 

SWITCH46 

1327 

IF(IFLAG(M> .EQ.l)  GO  TO  170 

SWITCH47 

1328 

L=M 

SWITCH48 

1329 

GO  TO  150 

SWITCH49 

1330 

170  DO  180  J*1 , HM 

SWITCH50 

1331 

180  CALL  PACK(1G,MAXGRD*( J-1)*M,NBITIN,  KB(J)  ) 

SWITCH51 

1332 

200  CONTINUE 

SWITCH52 

1333 

return 

SWITCH53 

1334 

END 

SWITCH54 

1335 

SUBROUTINE  MORRIS (LIST, NL » IG, III) 

MORRIS  2 

1336 

C  This  routine  oeletes  all  reference  in  the  connection  table 

IG 

MORRIS  3 

133/ 

C  TO  THOSE  POINTS  IN  A  LIST  OF  LENGTH  NL. 

MORRIS  4 

1338 

DIMENSION  IG(IIltl) , LIST(1) 

MORRIS  5 

1339 

COMMON  /S/  NN, MM 

MORRIS  6 

1340 

COMMON  /A/  MAXGRO 

MORRIS  7 

1341 

COMMON  /BITS/  N0I T IN , NB I T£ X 

MORRIS  8 

1342 

C  COMPRESS  OUT  DUPLICATE  ENTRIES  IN  LIST. 

MORRIS  9 

1343 

CALL  FIXIT(LIST,NL> 

MORRISIO 

1344 

IF(NL.LE.O)  RETURN 

MORRIS11 

1345 

MM  1  =  MM- 1 

M0RRIS12 

1346 

DO  60  I J=1 , NL 

MORRISl 3 

1347 

I=L  IS  T  ( I  Jl 

M0RRIS14 

1348 

00  50  J=1,MM 

MORRIS15 

1349 

L= IUNPK( IG, MAXGRO* (J-l) ♦I,N0ITIN) 

M0RRIS16 

1350 

IF(L.EQ.O)  GO  TO  60 

M0RRIS17 

1351 

K=0 

MORRISl 8 

1352 

20  K=K+1 

M0RRIS19 

1353 

M=  I UNPK ( IG, MAXGRO* (K-l) ♦L,NBITIN) 

MORRIS20 

1354 

IF ( M. NE. I)  GO  To  20 

MORRIS21 

1355 

IF(K.GE.MM)  GO  TO  40 

M0RRIS22 

1356 

00  30  N=K, MM1 

M0RRIS23 

1357 

IS=IUNPK (IG,MAXGRD*N>L,NBITIN) 

M0RRIS24 

1358 

30  CALL  PAC<(IG,MAXGRO*(N-l)*L,NDITIN,IS> 

M0RRIS25 

1359 

40  CALL  PAC<(IG,MAXGRO*MM1*L,NBITIN,0) 

M0RRIS26 

1360 

CALL  PACK ( I G, MAXGRO* (J-l) *1, N3 IT  IN, 0) 

M0RRIS27 

1361 

50  CONTINUE 

M0RRIS28 

1362 

60  CONTINUE 

M0RRIS29 

1363 

RETURN 

MORRIS30 

1364 

END 

MORRIS31 

1365 

SUBROUTINE  FIX  IT (L 1ST , NL ) 

FIXIT  2 

1366 

C  THIS  ROUTINE  COMPRESSES  OUT  ZEROES  AND  MULTIPLE 

ENTRIES  IN 

A  LIST 

FIXIT  3 

1367 

C  ORIGINALLY  OF  LENGTH  NL .  A  CORRECTED  LENGTH 

NL  IS  RETURNED  TO 

FIXIT  4 

1368 

C  THE  CALLING  PROGRAM. 

FIXIT  5 

1369 

OIMENSION  LIST ( 1 ) 

FIXIT  6 

1370 

IF(NL.LE.O)  RETURN 

FIXIT  7 

1371 

IF(NL.EQ.l)  GO  TO  HO 

FIXIT  8 

1372 

NL  1 =NL- 1 

FIXIT  g 

1373 

C  DELETE  DUPLICATE  ENTRIES. 

FIXIT  10 

1374 

DO  20  1=1, NL1 

FIXIT  11 

1375 

IF  C LI  ST ( 11 • EQ. 0 )  GO  TO  20 

FIXIT  12 

1376 

11=1*1 

FIXIT  13 

1377 

DO  10  J=  11,  NL 

FIXIT  14 

1378 

IF(LIST ( I) .NE.LIST (J) )  GO  TO  10 

FIXIT  15 

1379 

LIST (  I) =  0 

FIXIT  16 

1380 

GO  TO  20 

FIXIT  17 

1381 

10  CONTINUE 

FIXIT  18 

1382 

20  CONTINUE 

FIXIT  19 

1383 

C  OELETE  ZEROES. 

FIXIT  20 

1384 

DO  40  1=1, NL1 

FIXIT  21 

1385 

K=0 

FIXIT  22 

1386 

25  IF(LIST (I).NE.O)  GO  TO  40 

FIXIT  23 

1387 

K  =  K  ♦  1 

FIXIT  24 

1388 

DO  30  J= I , NL 1 

FIXIT  25 

1389 

30  LIST( J)=LIST (J+l) 

FIXIT  26 

1390 

LIST (NL) =0 

FIXIT  27 

1391 

IF(K.GE. (NL-I+1 ) )  GO  To  70 

FIXIT  28 

1392 

GO  TO  25 

FIXIT  29 

1393 

40  CONTINUE 

FIXIT  30 

1394 

C  CALCULATE  NEW  LENGTH  NL. 

FIXIT  31 

1395 

70  00  80  1=1, NL 

FIXIT  32 

1396 

J=NL- 1+1 

FIXIT  33 

1397 

IF( LIST ( J) .NE.O)  GO  TO  90 

FIXIT  34 

1398 

80  CONTINUE 

FIXIT  35 

1399 

90  NL-NL-I*! 

FIXIT  36 

1400 

39 


RETURN 

FIXIT  37 

1401 

110  IF (LIST ( U  *EQ. 0)  NL  =  0 

FIXIT  38 

1402 

return 

FIXIT  39 

1403 

END 

FIXIT  40 

1404 

SUBROUTINE  SCHEME ( NT , NUH , NOM , I  0 , IP, IG, III , IC , IDEG, 

IDIS, IW, 

SCHEME  2 

1405 

f  NEW , ICC, IlO, IPP) 

SCHEME  3 

1406 

c 

10  IS  VALID  IFF  2.LE.IO.LE.3 

SCHEME  4 

1407 

DIMENSION  IG(II1,1) , IC f 1) , IDEG(l) ,IDIS( 1> , IW  (1) 

SCHEME  5 

1408 

DIMENSION  NEWU  >  ,ICC  d  >  ,IlDdl  ,IPPd) 

SCHEME  6 

1409 

c 

IPP  HAS  DIMENSION  2*MAXDEG 

SCHEME  7 

1410 

COMMON  /$/  NN,MM,IH,IB 

SCHEME  8 

1411 

COMMON  /P/  IH0,IHE 

SCHEME  9 

1412 

COMMON  /A/  HAXGRO 

SCHEME  1 0 

1413 

COMMON  /C/  IWARN,L INE,K0RIG, KNEW 

SCHEME 1 1 

1414 

COMMON  /BITS/  N8IT IN, NBITEx, IPASS 

SCHEME12 

1415 

COMMON  /TIME/  ST IME , NCM 

SCHEME  1 3 

1416 

COMMON  /B/  IPARAM(20) 

SCHEME14 

1417 

COMMON  /OOL/  ISTARTI100 ) .IGNORE! 1001 , IFIRSTI100 ) 

SCHEHEl 5 

1418 

COMMON  /DOLL/  IDIM, ISTA , IIG, IFIR 

SCHEME16 

1419 

DIMENSION  NODESL (100) 

SCHEMEl 7 

1420 

equivalence  <ih,atime> 

SCHEME18 

1421 

c 

DETERMINE  THE  OEGREE  OF  EACH  NODE. 

SCHEME19 

1422 

CALL  OEGREE ( IG, III, IDEG) 

SCHEME20 

1423 

c 

DETERMINE  MOOD,  THE  MOST  PREVALENT  NODAL  DEGREE. 

SCHEME21 

142  4 

MODD=MODE (IDEG, IPP) 

SCHEME22 

1425 

c 

DETERMINE'  THE  NUMBER  OF  COMPONFNTS,  NCM. 

SCHEME23 

1426 

NCMsCOMPNT (IG, III, IC, IDEG, I W, ICC) 

SCHEME24 

1427 

c 

DETERMINE  THE  MAXIMUM  DEGREE  OF  ANY  NOOE. 

SCHEME25 

1428 

MAXO=MAXOGR (0 , IC, IOEG) 

SCHEME26 

1429 

MM=HA  XD 

SCHEME27 

1430 

c 

DETERMINE  THE  ORIGINAL  8 ANOW I D TH , I S . 

SCHEME28 

1431 

DO  30  1=1, NN 

SCHEME29 

1432 

NEW  (I >  =  I 

SCHEME30 

1433 

30  ILO ( I ) = I 

SCHEHE3). 

1434 

IS  =  MA  XBNO(0 ,IG, III ,IC , I  DEG , NE W , ILD) 

SCHEME32 

1435 

KOR IG=I S 

SCHEME33 

1436 

IHO  =  I H 

SCHEME34 

1437 

c 

INITIALIZE  NEW  ANO  ILO  ARRAYS. 

SCHEME35 

1438 

DO  35  1=1, NN 

SCHEME36 

1439 

NEW ( I ) =0 

SCHEME37 

1440 

35  ILD ( I ) =0 

SCHEME38 

1441 

c 

IF  IP  IS  NOT  EQUAL  TO  0,  THEN  PRINT  COMPONENT  NUMBE R, DEGREE , 

SCHEME39 

1442 

c 

AND  CONNECTIONS  FOR  EACH  NODE. 

SCHEME40 

1443 

IF  (IP.EQ.O)  GO  TO  31 

SCHEME41 

1444 

c 

PRINT  INTERNAL  NUMBER  CONNECTION  TABLE. 

SCHEME4  2 

1445 

00  Ml  1=1, NN 

SCHEME43 

1446 

IF (MODI  I, LINE) .EQ. 1) WRITE (6,  19) 

SCHEME44 

1447 

19  F0RMAT(3ZH1LABEL  COMP  MOIST  DEGR  CONNECTIONS  ,10X, 

SCHEME45 

1448 

1  18  H ( I NTERNAL  NUMBERS)  ) 

SCHEME46 

1449 

MDI ST  =  0 

SCHEME47 

1450 

DO  65  J= 1 , M AXO 

SCHEME48 

1451 

IS1=IUNPK(IG,MAXGR0«(J-1)*I,NBITINI 

SCHEME49 

1452 

IF ( IS  1 . EQ. 0 ) GO  TO  65 

SCHEMES  0 

1453 

MOIST=MAXO(MDIST,IABS(I-IS1) ) 

SCHEME51 

1454 

65  CONTINUE 

SCHEME52 

1455 

IPP(1)=IC(I) 

SCHEME53 

1456 

IPP ( 2 )  =  I  DEG ( I ) 

SCHEME54 

1457 

00  610  I Pl= 1 , MA  XD 

SCHEME55 

1458 

610  IPP(IPi*2)=IUNPK (IG.MAXGRD* ( IP1- 1) ♦ I , N0 IT  IN) 

SCHEME56 

1459 

IS1 =MAXD*2 

SCHEME5  7 

1460 

60  WRITE (6, 61) I, IPP(11 , MOIST , (IPP(J) ,J=2,IS1> 

SCHEME58 

1461 

61  F0RMAT(5I6, 2015/  2 5 ( 2 5X , 21 15 / > ) 

SCHEME59 

146? 

WRITE  (6,700) 

SCHEME60 

1463 

700  FORMAT dHl,// ,32X,31HPROGRAHMER  INFORMATION  MESSAGES  /> 

SCHEME61 

1464 

WRITE  (6,29)  I S , I H 

SCHEME62 

1465 

29  FORMAT ( 1 9H  ORIGINAL  9 ANOWIDTH , 17 , 10H  PROFILE, 110) 

SCHEME63 

1466 

HRITe<6,27)  MODD 

SCHEME64 

1467 

27  FORMAT  ( 3  OH  MOOE  OF  DEGREE  DISTRIBUTION  =,I5) 

SCHEME65 

1468 

IF( ISTA.LE. 0)  GO  TO  31 

SCHEME66 

1469 

write (6,701) 

SCHEME67 

1470 

701  FORMA  T  ( 34H  STARTING  NODES  SUPPLIED  BY  USER  -) 

SCHEME68 

1471 

WRITE  (6, 10  0 )  (I  START ( I ) , 1  =  1, ISTA) 

SCHEME69 

1472 

C 

TEST  TIMER. 

SCHEME7  0 

1473 

31  CALL  SECOND (TBEG) 

SCHEME71 

1474 

IF ( 10 . EQ . 3)  IS=IH 

SCHEME72 

1475 

C 

generate  numoering  scheme  for  each  component,  nc. 

SCHEME73 

1476 

DO  500  NC= 1 , NCM 

SCHEME74 

1477 

C 

DETERMINE  THE  RANGE  OF  DEGREES  (MI  TO  MAD)  OF  NODES  OF 

INTEREST 

.  SCHEME75 

1478 

HI=MINDEG(NC, IC, IDEG) 

SCHEME76 

1479 

MAD=MI 

SCHEME77 

1480 

IF (NOM)  90,87,90 

SCHEME78 

1481 

90  MA=MAXOGR(NC, IC, IDEG) 

SCHEME79 

1482 

MAD=HIM (MA-MI) *NUM)/NOM 

SCHEME8  0 

1483 

C 

MAKE  SURE  THAT  MAD  IS  LESS  THAN  MOOD. 

SCHEME81 

1484 

MAO=MINO (MAO,MODD-1> 

SCHENEB2 

1485 

MAD=M AXO (MAD, MI) 

SCHEME83 

1486 

C 

DETERMINE  BANDWIDTH  OR  SUM  CRITERION  FOR  EACH  NODE 

MEETING  SPECI- 

SCHEME84 

1487 

C 

FIED  CONDITION. 

SCHEME85 

1486 

87  IF (IP.EQ.O)  GO  TO  91 

SCHEME86 

1489 

WRITE (6, 162 )  NC 

SCHEME87 

1490 

162  FORMAT (22H  *******  COMPONENT , 15 , 12H  ******* 

) 

SCHEME88 

1491 

IF ( 10 . EQ . 2)  WRITE (6,169) 

SCHEME89 

1492 

169  FORMA  T ( 4 3H  OPTION  2  SELECTED  (CRITERION  -  BANDWIDTH  , 

SCHEME9  0 

1493 

*  57HMINIMIZATI0N;  CONDUlON  -  MINMAX  NUMBER  OF  NODES/LEVEL)  > 

SCHEME91 

1494 

IF ( 10. EQ. 3)  WRITE (6,179) 

SCHEME92 

1495 

179  FORMAT (5 2H  OPTION  3  SELECTED  (CRITERION  -  MINIMIZATION  OF 

sum;, 

SCHEME93 

1496 

44H  CONDITION  -  MINMAX  NUMBER  OF  NODES/LEVEL)  ) 

SCHEME94 

1497 

91  CALL  DIAMtNC, MAD, NL, NODESL, MAXLEV,IG, III, IC, IDEG, IDIS,IH, 

ICC) 

SCHEME95 

1498 

IF f IP .EQ. 0)  GO  TO  67 

SCHEME96 

1499 

WRITE (6, 39)  NC , H AO 

SCHEME97 

1500 

40 


HRI T£  ( 6, 59)  MAXLEV 

SCHEME98 

1501 

WRITE  (6,  100)  (NOOESL(J) ,J=1,NL> 

SCHEME99 

1502 

67 

CONTINUE 

SCHEM100 

1503 

IF(ISTA.LE.O)  GO  To  760 

SCHEM10 1 

1504 

M=  0 

SCHEM102 

1505 

OO  750  I=1,ISTA 

SCHEM103 

1506 

J=IST  ART  (I) 

SCHEM104 

1507 

IF< IC (J) .NE .NC)  GO  TO  750 

SCHEM105 

1508 

M=  M  ♦  1 

SCHEM106 

1509 

DO  755  K=l,99 

SCHEM10  7 

1510 

L=1 01-K 

SCHEM108 

1511 

755 

NODES L  CL) = NOOESL (L“l ) 

SCHEM109 

1512 

NOOESL ( 1 ) = J 

SCHEM110 

1513 

750 

CONTINUE 

SCHEM11 1 

1514 

NL=MIN0(NL*M,100) 

SCHEM112 

1515 

CALL  FIXlT<NOOESL,NL) 

SCMEM113 

1516 

760 

CONTINUE 

SCHEM114 

1517 

IF(  IP.EQ.0)  GO  TO  63 

SCHEM115 

1518 

IF(ISTA.LE.O)  GO  TO  63 

SCHEM116 

1519 

WRITE (6, 730) 

SCHEM117 

1520 

730 

FORMA  T  (48H  MERGED  LIST  OF  STARTING 

NODES  SUPPLIED  BY 

USER  , 

SCHEM118 

1521 

4 

15HAN0  BY  BANDIT  -> 

SCHEM119 

1522 

WRI TE  <6, 100 )  (NOOESL(I) »I=1,NL) 

SCHEM120 

1523 

39 

FORMAT ( 1  OH  COMPONENT, 15, 19H  MAX 

DEGREE  USED, 15) 

SCHEM121 

1524 

59 

FORMAT (52H  STARTING  NODES  FOR  MINMAX  NUMBER  OF  NODES 

PER  LEVEL, 

,  15 ) SCHEM122 

1525 

100 

FORMA  T ( 4X , 2  0 15 ) 

SCHEM123 

1526 

63 

CONTINUE 

SCHEM124 

1527 

JMAX=MINO(NT,NL) 

SCHEM125 

1528 

IM=900000000 

SCHEH126 

1529 

IMM=IM 

SCHEM127 

1530 

00  400  J=1,JMAX 

SCHEM128 

1531 

CALL  RELABL ( 1 , NODESL ( J  >,IG,II1,IC 

,  IDEG, IDIS,IW,NEW, 

ICC, ILO) 

SCHEM129 

1532 

IB=MAXBNO(NC, IG, II1,IC, IOEG,NEW, ILD) 

SCHEM13Q 

1533 

IF(IP.NE.O)  WR ITE(6,69)  NODESL(J), 

I  B ,  IH 

SCHEM131 

1534 

69 

FORMATUAH  STARTING  NOD E , 1 6 , A  X , 9H8 AN  OKI  DTK , 16, 3 X , ?H PROF ILE,  I« > 

SCHEM132 

1535 

IF ( IO.EQ .3)  IB=IH 

SCHEM133 

1536 

IE= ICC ( NC* 1 ) - 1 

SCHEM134 

1537 

IF(IM-IB)  400,350,300 

SCHEM135 

1538 

300 

IM=IB 

SCHEM1 36 

1539 

IMM=IM 

SCHEM137 

1540 

I  J=  J 

SCHEM13  8 

1541 

GO  TO  400 

SCHEM139 

1542 

350 

IF( IMM.LE.IH)  GO  TO  400 

SCHEM140 

1543 

IMM=IH 

SCHEM141 

1544 

I J  =  J 

SCHEM142 

1545 

400 

CONTINUE 

SCHEM143 

1546 

CALL  RELABL (1, NOOESL (IJ) ,IG, II1,IC 

, IDEG, IDIS,IW, NEW, 

ICC, ILD) 

SCHEM144 

1547 

500 

CONTINUE 

SCHEM145 

1548 

CALL  STACKt IOEG , NEW, I LD , IW) 

SCHEM146 

1549 

IB=MAXBNO(0 ,IG,II1 ,IC, I  DEG, NEW, ILD) 

SCHEM147 

1550 

IF(IP.EQ.O)  GO  TO  710 

SCHEM14B 

1551 

WRITE  (6,705) 

SCHEM149 

1552 

705 

FORMAT(?1MO  ORIGINAL  LABELING  -) 

SCHEM150 

1553 

WRI TE  (6 , 708 )  KORIG,IHO 

SCHEM151 

1554 

WRITE  (6,707) 

SCHEM152 

1555 

707 

FORMAT (21H  STO  CM  RELABELING  -> 

SCHEM153 

1556 

WRITE  (6,  708)  IB , IH 

SCHEM154 

1557 

705 

FORMAT  (1H*,26X,9H9ANDWI0TH, 17, 10 X, 

7HPROFILE,  110) 

SCHEM155 

1558 

709 

FORMAT (?1H  REV  CM  RELABELING  -> 

SCHEM156 

1559 

710 

IF ( 10  .EQ  .  3)  18  =  I H 

SCHEM157 

1560 

C 

PROFILE  =  SUM  CRIT 

SCHEM158 

1561 

c 

I S  =0  RIG  INAL  3AN0HIDTH  (OR  SUM  CRIT  IF 

IO.EQ.3) 

SCHEM159 

1562 

c 

I B=CURRENT  BANDWIDTH  (OR  SUM  CRIT  IF  IO.EQ.3) 

SCHEM160 

1563 

c 

I H  =C  URRENT  PROFILE.  IHO=ORIGINAL  PROFILE 

SCHEM161 

1564 

IF(IB-IS)  715,742,744 

SCHEM162 

1565 

74? 

IF(IH.LT.IHO)  GO  TO  715 

SCHEM163 

1566 

744 

DO  712  1=1, NN 

SCHEM164 

1567 

ILD  ( I )  =  I 

SCHEM165 

1568 

71? 

NEW ( I)=I 

SCHEM166 

1569 

CALL  STACK(IDEG,NEW,ILO,IW) 

SCHEM167 

1570 

18=  IS 

SCHEM168 

1571 

IH= IH  0 

SCHEM169 

1572 

IF  ( IP  .EQ. 0)  GO  TO  715 

SCHEM170 

1573 

WRITE  (6,713) 

SCHEM17 1 

1574 

713 

FORMA  T ( 2 IH  ORIG  CM  RELABELING  -) 

SCHEM172 

1575 

WRITE  (6,708)  IB,IH 

SCKEM173 

1576 

715 

IHE  =  I H 

SCHEM174 

1577 

CALL  RE VERS (NEW , ILO) 

SCHEM175 

1578 

IB=MAXBNO(0 ,IG,II1,IC, IOEG , NEW, ILO) 

SCHEM176 

1579 

IF  (IP.EQ.0)  GO  TO  717 

SCHEM177 

1580 

WRITE (6, 709) 

SCHEM178 

1581 

WRITE  (6, 708)  18,  IH 

SCHEM179 

1582 

717 

IF(IH.LT. IHE)  GO  TO  720 

SCHEM18  0 

1583 

CALL  REVERS (NEW, ILD) 

SCHEM181 

1584 

I9=MAXBN0(0,IG, 1 11 »IC, I  DEG  ,  N EW , I LD) 

SCHEM182 

1585 

720 

IHEdH 

SCHEM183 

1586 

KNEW= IB 

SCHEM184 

1587 

IF (IP.EQ.0)  GO  TO  508 

SCHEM185 

1588 

WRITE  (6,722) 

SCHEM186 

1589 

722 

FORHAT ( 2 IH  **  FINAL  LABELING  -) 

SCHEM187 

1590 

WRITE (6,708)  KNEW, IHE 

SCHEM188 

1591 

50  0 

CALL  SECOND (ATIME) 

SCHEM189 

1592 

ATIME=ATIME-TBEG 

SCHEM190 

1593 

IF(IP.EQ.O)  GO  TO  600 

SCHEM191 

1594 

WRITE (6, 89) ATIME 

SCHEM192 

1595 

89 

FORMA  T ( 7H  TIME  =,F9.3,6H  SEC.) 

SCHEM193 

1596 

600 

RETURN 

SCHEM194 

1597 

END 

SCHEM195 

1598 

SUBROUTINE  STACK (IOEG, NEW, ILD, IW) 

STACK  2 

1599 

c 

STACK  POINTS  OF  ZERO  DEGREE  AT  END  OF 

THE  NUMBERING. 

STACK  3 

1600 
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DIMENSION  IOEG(l) , NEW(1> , ILD(1),IW(1) 

STACK  4 

1601 

C  IW  I.S  SCRATCH  STORAGE. 

STACK  5 

1602 

COMMON  /S/  NN 

STACK  6 

1603 

COMMON  /ZERO/  KT 

STACK  7 

1604 

KT*  0 

STACK  8 

1605 

NNi*NN-l 

STACK  9 

1606 

C  LIST  POINTS  OF  ZERO  DEGREE  ANO  INCREMENT  COUNTER  KT 

• 

STACK  10 

1607 

DO  10  1*1, NN 

STACK  11 

1608 

IF(IDEG(I) .GT.O)  GO  TO  10 

STACK  12 

1609 

KT*KTU 

STACK  13 

1610 

IHUT)  =  ILD(I> 

STACK  14 

1611 

10  CONTINUE 

STACK  15 

1612 

IF(KT.LE.O)  GO  TO  70 

STACK  16 

1613 

C  SORT  LIST  OF  RENUMBERED  NUMBERS  TO  BE  STACKED. 

STACK  17 

1614 

CALL  SORT ( I W, KT ) 

STACK  18 

1615 

C  STACK  POINTS  OF  ZERO  OEGREF  AT  ENO  OF  NEW. 

STACK  19 

1616 

►— 

* 

M 

_J 

o 

J- 

O 

O 

STACK  20 

1617 

I*IW(L)-L*1 

STACK  21 

1618 

K*NEW  ( I ) 

STACK  22 

1619 

IF(I.GE.NN)  GO  TO  30 

STACK  23 

1620 

DO  20  J=»I,NN1 

STACK  24 

1621 

20  NEW< J)=NEW( J+l) 

STACK  25 

1622 

30  NEW  (NN)  =K 

STACK  26 

1623 

A0  CONTINUE 

STACK  27 

1624 

C  CORRECT  ILO,  THE  INVERSE  OF  NEW. 

STACK  28 

1625 

70  DO  80  1=1, NN 

STACK  29 

1626 

K*NEW  (I) 

STACK  30 

1627 

80  ILD (K ) *  I 

STACK  31 

1628 

RETURN 

STACK  32 

1629 

END 

STACK  33 

1630 

SUBROUTINE  REVERS ( NEW , I L D) 

REVERS  2 

1631 

C  REVERSE  THE  NUMBERING  OF  THE  FIRST  NN-KT  GRID  POINTS. 

REVERS  3 

1632 

C  NN*NUMBER  OF  GRID  POINTS. 

REVERS  4 

1633 

C  KT=THE  NUMBER  OF  points  OF  ZERO  OEGREE  (STACKED  »T  ENO 

OF  NEW 

REVERS  5 

1634 

C  BY  STACK) 

REVERS  6 

1635 

DIMENSION  NEW  ( 1  )  ,  ILOH  ) 

REVERS  7 

1636 

COMMON  /S/  NN 

REVERS  8 

1637 

COMMON  /ZERO/  KT 

REVERS  9 

1638 

C  REVERSE  NEW  ARRAY. 

REVERS1 0 

1639 

J= (NN-KT ) / 2 

REVERS1 1 

1640 

LL=NN-KT*1 

REVERS1 2 

1641 

DO  10  1=1, J 

REVERS1 3 

1642 

L-LL-  I 

REVERS1 4 

1643 

K=NEW  (L> 

REVERS15 

1644 

*  NEW (l)=NEW(I) 

REVERS16 

1645 

10  NEW  <  I  )  =  K 

REVERSl 7 

1646 

C  CORRECT  ILD,  THE  INVERSE  OF  NEW. 

REVERS18 

1647 

DO  20  1=1, NN 

REVERS19 

1648 

K=NEW  (I) 

REVERS2Q 

1649 

20  ILO ( K ) =1 

REVERS21 

1650 

RETURN 

REVERS22 

1651 

END 

REVERS23 

1652 

SUBROUTINE  DEGREE ( IG , I I 1 , IOE G ) 

DEGREE  2 

1653 

C  SET  UP  THE  I DEG  ARRAY  CONTAINING  THE  OEGREE  OF  EACH 

NODE  STORED 

DEGREE  3 

1654 

C  IN  THE  IG  ARRAY. 

DEGREE  4 

1655 

C  IOEG ( I ) =DEGREE  OF  NODE  I 

DEGREE  5 

1656 

DIMENSION  IG(IIlfl) ,IOEG(l) 

DEGREE  6 

1657 

COMMON  /S/  NN,MM,IH,IB 

OEGREE  7 

1658 

COMMON  /A/  MAXGRD 

DEGREE  8 

1659 

COMMON  /BITS/  NBIT IN, NB ITE X , IPASS 

OEGREE  9 

1660 

DO  100  1=1, NN 

OEGREE10 

1661 

IDE  G  <  I )  =  0 

DEGREE11 

1662 

DO  80  J= 1 , MM 

DEGREE12 

1663 

IF( IUNPK (IG, MAXGRD* (J-l) ♦I,NBI TIN) )  100, 100, 50 

0EGREE13 

1664 

50  IOEG(I)=IDEG(I)+l 

DEGREE14 

1665 

80  CONTINUE 

0EGREE15 

1666 

100  CONTINUE 

DEGREE16 

1667 

RETURN 

DEGREE17 

1668 

END 

DEGREE18 

1669 

FUNCTION  MODE (IDEG,MODD) 

MODE  2 

1670 

C  COMPUTE  MODE,  THE  MOST  PREVALENT  NODAL  OEGREE.  IF 

SEVERAL  OEGREES 

MODE  3 

1671 

C  ARE  EQUALLY  PREVALENT,  THE  LOWEST  IS  CHOSEN. 

MOOE  4 

1672 

COMMON  /S/  NN, MM 

MOOE  5 

1673 

DIMENSION  IOEG(I) ,MODD(l) 

MODE  6 

1674 

C  IOEG (I) =DEGREE  OF  NODE  I 

MODE  7 

1675 

C  MOO D ( I )  =  NUMBER  OF  NODES  OF  OEGREE  I 

MODE  8 

1676 

DO  10  1=1, MM 

MOOE  9 

1677 

10  MOOD (  I )  =  0 

MODE  10 

1678 

DO  20  1=1, NN 

MODE  11 

1679 

K= I  DEG ( I ) 

MODE  12 

1680 

20  MODO(K)=MODD(K)*l 

MODE  13 

1681 

MODE=  0 

MODE  14 

1682 

MAX  =  0 

MODE  15 

1683 

DO  30  1=1, MM 

MODE  16 

1684 

K=MOOO( I) 

MODE  17 

1685 

IF ( K. LE . MAX)  GO  To  30 

MODE  18 

1686 

MAX  =  K 

MOOE  19 

1687 

MODE=  I 

MODE  20 

1608 

30  CONTINUE 

MODE  21 

1689 

RETURN 

MODE  22 

1690 

ENO 

MODE  23 

1691 

FUNCTION  COMPNT  (IG,II 1, IC, IOEG,  I W, ICC) 

COMPNT  2 

1692 

c  this  function  has  as  its  value  the  number  of  components 

STORED 

COMPNT  3 

1693 

C  IN  THE  CONNECTION  ARRAY  IG. 

COMPNT  4 

1694 

C  ALSO,  IC  ANO  ICC  ARE  SET  UP. 

COMPNT  5 

1695 

C  IC(I)  COMPONENT  INDEX  FOR  NODE  I 

COMPNT  6 

1696 

C  ICC ( I ) =THE  STARTING  POSITION  TO  BE  USED  FOR  LABELS 

IN 

COMPONENT  I 

COMPNT  7 

1697 

C  THUS,  ICC  (1  +  1) - ICC  ( I ) =  THE  NUMBER  OF  NODES  IN  COMPONENT 

I 

COMPNT  8 

1698 

DIMENSION  IG ( III ,1 ) , I C ( 1 ) , IDEG  ( 1 ) ,IW  .1) ,ICC(1) 

COMPNT  9 

1699 

COMMON  /S/  NN,MM, IH, IB 

COMPNT 1 0 

1700 
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COMMON  /A/  MAXGRD 
COMMON  /BITS/  NBITIN, NBITEX, IPASS 
C  INITIALIZE  ARRAYS. 

00  100  1*1, NN 
ICCCI)*0 

icm  *o 

100  CONTINUE 
NC*  0 

ICCC1)*1 

C  CHECK  IF  IC  IS  COMPLETE. 

105  DO  110  1*1 , NN 

IF  ( IC ( I )  )  110,120,110 
110  COMPNT=NC 
RETURN 
120  NC=NC*1 
KI=  0 
KO*l 
IH ( 1) =1 
IC ( I) =NC 

IF(NC-l) 130,125,125 
125  IS* ICC ( NC) ♦ 1 
ICC(NC+1)=IS 
130  KI*KI *1 
1 1=  I H  (KI) 

N= IOEG( I I) 

IF ( N)  14  0, 105,1 A0 
140  DO  200  1*1, N 

IA=IUNPK (IG, HAXGRO* (I~l ) +II»  MBIT  IN) 

IF < IC  ( IA) I  200,150,200 
150  IC  < IA )  =  NC 
KO=KO*l 
IN ( KO)  =  I  A 
IS=ICC(NC+1)+1 
ICC  (NC+l ) = IS 
200  CONTINUE 

IF(KO-KI)105, 105,130 
END 

FUNCTION  MAXOGR ( NC , IC , I  DEG) 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MAXIMUM  DEGREE  OF  ANY  NODE  OF 
C  COMPONENT  NC  IF  NC.GT.O 

C  IF  NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 

DIMENSION  IC(1) , IDEG(I) 

COMMON  /S/  NN,MM, IH, IB 
K=  0 

DO  100  1=1, NN 
IF ( NC ) 40 , 50 , 40 

40  IF ( IC (I) -NC)  100,50,100 

50  IF ( IOEG ( I) -M)  100,100,60 

60  M= IOEG ( I ) 

100  CONTINUE 
MAXDGR=M 
RETURN 
END 

FUNCTION  MAX8ND(NC,IG,IIi,IC,IDEG,NEW,ILD) 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MAXIMUM  DIFFERENCE  BETWEEN  NODE 
C  LABELS  OF  CONNECTED  NODES  FOR  NODES  OF  COMPONENT  NC.GT.O 
C  IF  NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 

C  THE  NODAL  RENUMBERING  DEFINED  BY  ILD  AND  NEW  MUST  BE  SET  UP  PRIOR 
C  TO  THE  FUNCTION  CALL. 

C  COMPUTE  IH,  THE  SUM  CRIT  (PROFILE). 

DIMENSION  IG(II1,1),IC(1),IDEG(1) , NE W( 1 ) , I LD ( 1 ) 

COMMON  /S/  NN, MM, IH, IB 

COMMON  /A/  HAXGRO 

COMMON  /BITS/ .NBITIN, NBITEX, IPASS 

IH=  0 

M=0 

DO  100  1=1, NN 
MX=  0 

IA=NEH ( I ) 

IF(NC)40,50,40 
40  IF ( IA .EQ. 0) GO  TO  100 

IFCNC-IC (IA) )  100,50,100 
50  N= I OEG ( I  A) 

IF ( N) 100,100,150 
150  DO  90  J=1,N 

11= IUNPK (IG,MAXGR0*(J-1)+1A, NBITIN) 

IB  =  MAX0(  0,  I-ILD-(II) ) 

IF(IB.GT.MX)  MX=IB 
90  CONTINUE 

IF(MX.GT.M)  M=MX 
IH= IH  +MX 
100  CONTINUE 

MAXBNO=M 
RETURN 
ENO 

FUNCTION  MINOEG (NC, IC , IOEG) 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MINIMUM  DEGREE  OF  ANY  NODE  OF 
C  COMPONENT  NC  IF  NC.GT.O 

C  IF  NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 


DIMENSION  IC(1)  , 

IOEG(l) 

COMMON  / 3/  NN , MM 

,  IH,  I  B 

M=1 00  00 

00  100  1=1, NN 

IF(NC)40 ,50 ,40 

40 

IF ( IC (I) -NC)  100 

,50,100 

50 

IF {M-IDEG(I ) )  10 

0, 100,60 

60 

M= IOE  G ( I ) 

100  CONTINUE 
MINDEGsM 
RETURN 
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END 

M  INDE&l 7 

1001 

SUBROUTINE  O I  AM ( NC , MA XOEG , NL 

, NODESL 

, MAXLEV  , 

DIAM  2 

1802 

^  IG,II1, IC, IOEG.IDIS, IW.ICC) 

OIAM  3 

1803 

C  DETERMINE  NL  STARTING  POINTS  AND 

STORE 

IN  NOOESL. 

0  I A  M  4 

1804 

DIMENSION  IGt IIl,i> , IOIS<  1) , 

IW(1> , ICC (1) ,IC(1) , IOEG (1) 

01AM  5 

1805 

COMMON  /S/  NN, MM, IH* I B 

DIAM  6 

1806 

COMMON  /A/  MAXGRD 

OIAM  7 

1807 

COMMON  /BITS/  NBITIN, NBITEX, 

IPASS 

OIAM  0 

1808 

DIMENSION  NOOESL(l) 

DIAM  9 

1809 

NL  =  0 

DIAM  10 

1810 

MAXLEV= 10000 

OIAM  11 

1811 

DO  10  0  I  =  1  *  NN 

OIAM  12 

1812 

IF  (  NC  -  IC  <  I  >  )  10  0,40,100 

OIAM  13 

1813 

40 

IF(MAXOEG-IDEGtl))  100,105,105 

OIAM  14 

1814 

105 

MD  = IO 1ST { I  *  ML ,MAXLEV,  IG* III, 

IC , IOEG 

, IOIS,IW, ICC) 

OIAM  15 

1815 

IF(MD)  115,115,56 

DIAM  16 

1616 

56 

IF<  ML -MAXLF V)  58 ,64, 10  0 

OIAM  17 

1817 

53 

MAXLE  V  =  ML 

OIAM  18 

1616 

NL  =  1 

OIAM  19 

1819 

NOOESL ( 1 ) = I 

OIAM  20 

1820 

GO  TO  100 

DIAM  21 

1821 

64 

IFTNL.GE. 100)  GO  TO  100 

DIAM  22 

1622 

NL  =  NL  +  1 

01AM  23 

1823 

NOOESL  <  NL)  =  I 

OIAM  24 

1824 

100 

CONTINUE 

DIAM  25 

1825 

110 

return' 

OIAM  26 

1826 

116 

ML=1 

DIAM  27 

1827 

NOOESL(1)=I 

DIAM  28 

1828 

maxlev=o 

DIAM  29 

1829 

RETURN 

DIAM  30 

1830 

END 

DIAM  31 

1631 

SUBROUTINE  RELABL(nS, NOOES, IG, IIl,IC,IOEG, ID IS, IW,NEW, ICC,ILO) 

RELABL  2 

1632 

C  GENERATE  A  RELABELING  SCHEME  STARTING  WITH  NS  NOOES  FOR  WHICH 

RELABL  3 

1833 

C 

LABELS  HA  VF  BEEN  STOREO  IN 

ARRAY  1 

NODES. 

RELABL  4 

1834 

c  set 

UP  IL O  AND  NEW. 

RELABL  5 

1835 

C 

ILD ( OLD ) =NFW 

RELABL  6 

1836 

C 

NEW(NFW) =OLD,  THE  INVERSE 

OF  ILD 

RELABL  7 

1837 

DIMENSION  IGtIIl.l) , ICC  1) , IDFGIl ) , IDISl 1) , IH ( 1 )  ,NEM (1) > ICCI1) 

RELABL  8 

1636 

DIMENSION  ILO(l) 

RELABL  9 

1839 

COMMON  /S/  NN, MM , I H, I 8 

RELAB110 

1640 

integer  X 

RELABL 1 1 

1641 

COMMON  /A/  MAXGRD 

RELABL12 

1842 

COMMON  /BITS/  NB I T IN , NB I T E X , 

IPASS 

RELABL 1 3 

1843 

dimension  NOOES<  1 )  , I  A J  (  50 ) 

RELA8L14 

1644 

I=NODES ( 1) 

RELABL15 

1845 

ICN=IC(I> 

RELABL 16 

1846 

NT=  ICC ( ICN) -1 

RELABL 1 7 

1847 

OO  50  1=1, NN 

RELABL18 

1848 

IF( IC(I) -ICN)  50,40,50 

RELABL19 

1849 

1*0 

IDISC I) =0 

RELABL20 

1850 

50 

CONTINUE 

RELABL21 

1051 

DO  100  J  =  1 »  NS 

RELABL22 

1852 

JJ=NODES(J) 

RELABL23 

1853 

ID  I S ( J J) =-l 

RELABL24 

1854 

JT  =  J+  NT 

RELABL25 

1655 

NEW ( JT) = JJ 

RELABL26 

1856 

100 

ILO (JJ)= JT 

RELABL27 

1857 

KI  =  NT 

RELA8L28 

1858 

KO=NS+NT 

RELA8L29 

1859 

LL  =  KO 

RELABL30 

1860 

L=  1 

RELABL31 

1861 

J=KO 

RELABL32 

1862 

NNC=ICC(ICN+1)-1 

RELABL33 

1863 

130 

KI=KI+1 

RELABL34 

1864 

IF <KI-LL) 135,132,135 

RELA9L35 

1865 

132 

L  =  L  ♦  1 

RELABL36 

1866 

LL=KO*l 

RELABL37 

1867 

135 

1 1  =  NE  W  <  K I ) 

RELABL38 

1668 

N=  I  DE  G  (  1 1 ) 

RELABL39 

1869 

IF  <  N>  140,255,140 

RELA8L40 

1870 

140 

IJ=0 

RELABL41 

1871 

DO  200  1=1, N 

RELABL42 

1872 

IA=IUNPK( IG,MAXGRDMI-1) ♦ I I, NBITIN) 

RELABL43 

1873 

IF  < ID  IS ( IA ) )  200,150,200 

RELABL44 

1874 

150 

IJ=IJ+1 

RELABL45 

1875 

IOIS( IA) =L 

RELA9L46 

1876 

KO=KO*l 

RELABL47 

1677 

IA  J  ( I  J)  =  IA 

RELA8L48 

1878 

IW ( I J )  =  IOEG ( I A ) 

RELABL49 

1879 

200 

CONTINUE 

RELABL50 

1660 

IF(IJ-l) 250,210,220 

RELABL51 

1881 

210 

J=KO 

RELA8L52 

1882 

IZ= I A J (1 ) 

RELA8L53 

1863 

NEW ( KO) £ IZ 

RELABL54 

1884 

ILD  (  I Z) “KO 

RELABL55 

1885 

GO  TO  250 

RELA8L56 

1866 

220 

X-  0 

RELABL57 

1687 

221 

DO  230  1=2, IJ 

RELABL58 

1668 

IF IIW  (I) -IWCI-1) )  224,  230,230 

RELABL59 

1869 

224 

CONTINUE 

RELABL60 

1890 

X=IW( I) 

RELABL61 

1891 

IW(I) =IW(I-1) 

RELABL62 

1692 

IW  ( I- 1 )  =  X 

RELABL63 

1893 

225 

X=I A J (I) 

RELABL64 

1894 

IA  J  ( I )  =  I AJ  ( I- 1 ) 

RELABL65 

1895 

I A J fl-l) =X 

RELA9L66 

1896 

230 

CONTINUE 

RELAB167 

1897 

IF  C  X)  235,235,220 

RELABL68 

1696 

235 

DO  240  1=1, IJ 

RELABL69 

1899 

J=J  +  1 

RELABL70 

1900 

44 


IZ=IAJ(I) 

NEW(J)=IZ 
ILO(IZ)=J 
240  CONTINUE 
250  IF(KO-NNC) 130,255,255 
255  CONTINUE 
RETURN 
END 

FUNCTION  IDIST(NS,ML,HAXLEV,IG,II1,IC,IDEG,IDIS,IW,ICC> 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MAXIMUM  DISTANCE  OF  ANY  NODE 
C  IN  COMPONENT  IC (NS)  FROM  THE  NODE  NS. 

C  THE  DISTANCE  OF  EACH  NODE  IN  THIS  COMPONENT  IS  STORED  IN  THE  ARRAY 
C  IDIS. 

C  THE  MAXIMUM  NUMBER  OF  NODES  AT  THE  SAME  DISTANCE  FROM  NS  IS 
C  STORED  IN  ML. 

DIMENSION  IG(II1»1)»IC(1) ,  IDEG (1),I0IS(1),IH(1), ICC (1) 

COMMON  /S/  NN, MM, IH, IB 

COMMON  /^/  MAXGRD 

COMMON  /BITS/  NBITIN,NBITEX,IPASS 

ICN=IC (NS) 

NNC=ICC(ICN*1>-ICC (ICN) 

DO  50  1=1, NN 

IF(IC(I)-IC(NS> >  50,40,50 
40  IDISI I) =0 

50  CONTINUE 
LL= 1 
L=0 
KI  =  0 
KO=  1 
ML=  0 

IH ( 1 ) =NS 
10  IS ( NS) =-l 
130  KI=KI+1 

IFCKI-LL) 135,132,135 

132  L=L  +  1 
LL  =  KO  + 1 
K=KO-KI+l 

IFCK-ML)  135,135,133 

133  ML=K 

IF ( ML-MAXLEV)  135,135,220 
135  II=IM( KI) 

N=IDEG( I I) 

IF ( N>  140,215,140 
140  DO  200  1=1, N 

IA=IUNPK < IG, MAXGRD* <I-1) +11,  NB IT  IN) 

IF  €  I D IS  C IA) >  200, 150,200 
150  IOI S ( IA ) =L 


KO=KO+l 
I W ( KO ) = I  A 
200  CONTINUE 

IF ( KO-NNC) 130,205,205 

205  IDIST  =L 
IDIS ( NS) =0 
K=KO-KI 

IF(K-ML)  206,206,207 
207  ML=K 

206  CONTINUE 
RETURN 

215  L= 0 

GO  TO  205 
220  IDIST=1 
RETURN 
END 


IDENT  PCUP 

LIST  D,M,A 

ENTRY  PACK,IPACK,UNPK,IUNPK,ABT 
EXT  CPC 

USE  /BITS/ 

BSS  2 


IPASS 

BSS 

1 

USE 

0 

SIXTY 

OATA 

60. 

PACK 

BSSZ 

1 

IPACK 

EQU 

PACK 

*  SET  FLAG  TO  INDICATE  A  PACK  INSTRUCTION  REQUIRED 

SB1  1 

*  LOAD  A0  WITH  THE  ADDRESS  OF  THE  ARGUMENT  LIST 

INIT  SB7  A0 

S  AO  A1 

*  INCREASE  ITERATION  INDEX  BY  ONE 

SA5  IPASS 

SX6  1 

1X6  X5+X6 

SA6  A5  +  B0 

*  LOAO  X6  WITH  THE  ADDRESS  OF  ARGUMENT  LIST  FOR  LATER  LOADING  OF 

*  PACKED  WORD 

BX6  XI 

*  LOAO  XI  WITH  THE  SUBSCRIPT  OF  THE  ARR1Y 

SA1  AO  +  1 

SA1  XI 

*  CONVERT  SUBSCRIPT  FROM  INTEGER  TO  REAL 

PX1  BO, XI 

NX1  XI 

*  LOAD  X2  WITH  THE  NUMBER  OF  BITS  PER  WORD 

SA2  SIXTY 

*  LOAD  X3  WITH  THE  NUMBER  OF  BITS  TO  BE  DEVOTED  TO  EACH  PACKED  HORD 

S  A3  AO+2 

S  A3  X3 

*  LOAD  B6  WITH  THE  NUMBER  OF  BITS  IN  HORD  NOT  DEVOTED  TO  THE  PACKEO 

*  HORD 


RELABL71 
RELABL72 
RELABL7  3 
RELABL74 
RELABL75 
RELABL76 
RELA0L77 
RELABL70 
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31 

1936 
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32 
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36 
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IOIST 

37 

1944 
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30 

1945 
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39 

1946 
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1947 
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41 

1940 

IOIST 

42 

1949 

IDIST 
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40 

1955 

IDIST 

49 

1956 
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50 

1957 
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51 

1950 

IDIST 

52 

1959 

IDIST 

53 

1960 

IDIST 

54 

1961 
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55 
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56 

1963 

PCUP 

2 

1964 

PCUP 
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1965 

PCUP 
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1966 

PCUP 

5 

1967 

PCUP 
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1960 

PCUP 
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1969 

PCUP 
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1970 

PCUP 

9 

1971 

PCUP 

10 

1972 

PCUP 

11 

1973 

PCUP 

12 

1974 

PCUP 

13 

1975 

PCUP 

14 

1976 

PCUP- 

15 

1977 

PCUP 

16 

1976 

PCUP 

17 

1979 

PCUP 

18 

I960 

PCUP 

19 

1901 

PCUP 

20 

1902 

PCUP 

21 

1903 

PCUP 

22 

1904 

PCUP 

23 

1905 

PCUP 

24 

1906 

PCUP 

25 

1907 

PCUP 

26 

I960 

PCUP 

27 

1909 

PCUP 

20 

1990 

PCUP 

29 

1991 

PCUP 

30 

1992 

PCUP 

31 

1993 

PCUP 

32 

1994 

PCUP 

33 

1995 

PCUP 

34 

1996 

PCUP 

35 

1997 

PCUP 

36 

1990 

PCUP 

37 

1999 

PCUP 

30 

2000 

45 


SB6  X3-60 

PGUP  39 

2001 

SB6  -B6 

PCUP  40 

2002 

• 

CONVERT  THE  NUMBER  OF  BITS  PER  PACKEO  WORD  FROM  INTEGE 

R  TO  REAL 

PCUP  41 

2003 

PX3  80  ,  X 3 

PCUP  42 

2004 

NX3  X3 

PCUP  43 

2005 

* 

LOAD  X?  WITH  THE  NUMBER  OF  PACKED  WORDS  THAT  CAN  EXIST 

PER  60  BIT 

PCUP  44 

2006 

* 

WORD 

PCUP  45 

2007 

FX2  X2/X3 

PCUP  46 

2006 

• 

TRUNCATE  X2  TO  LOSE  ANY  FRACTIONAL  PART 

PCUP  4  7 

2009 

UX2  B2,X2 

PCUP  48 

2010 

LX2  92, X2 

PCUP  49 

2011 

PX2  90, X2 

PCUP  50 

2012 

NX2  X2 

PCUP  51 

2013 

* 

LOAD  X5  HUH  THE  NUMBER  OF  60  BIT  WORDS  NECESSARY  TO  LOCATE  THE 

f>CUP  52 

2014 

* 

POSITION  IN  ABSOLUTE  CORE  THAT  THE  VARIABLE  ADDRESSEO 

PCUP  53 

2015 

FX5  X1/X2 

PCUP  54 

2016 

» 

convert  X5  To  integer  briefly  for  an  integer  add  operation 

PCUP  55 

2017 

UX5  B2,X5 

PCUP  56 

2018 

LX5  82 ,  X5 

PCUP  5 7 

2019 

* 

X6  NOW  POINTS  To  the  absolute  location  in  core  containing  the 

PCUP  58 

2020 

♦ 

variable  oesireo 

PCUP  59 

2021 

1X6  X5  +  X6 

PCUP  60 

2022 

PX5  90, X5 

PCUP  61 

2023 

NX5  X5 

PCUP  62 

2024 

* 

LOAD  X 4  WITH  THE  NUMBER  OF  WHOLE  60  BIT  WORDS  TO  FIND 

THE  LOCATION 

PCUP  63 

2025 

V 

OESIRFD 

PCUP  64 

2026 

FX4  X2*  X5 

PCUP  65 

2027 

* 

X 4  NOW  CONTAINS  OFFSET  WITHIN  THE  LOCATION  FOR  PACKEO 

VALUE 

PCUP  66 

2026 

FX4  X1-X4 

PCUP  67 

2029 

NX4  X  4 

PCUP  68 

2030 

CONVERT  X4  TO  INTEGER  BRIEFLY  FOR  COMPARISON  PURPOSES 

PCUP  69 

2031 

UX4  B2,X4 

PCUP  70 

2032 

LX4  02 , X4 

PCUP  71 

2033 

* 

SET  X6  TO  ITSELF  -  1  FOR  A  ZERO  X4  VALUE 

PCUP  72 

2034 

* 

X 4  =  0  INDICATES  THAT  THE  PACKEO  VARIABLE  ENOS  ON  A  WORD  BOUNDARY 

PCUP  73 

2035 

NZ  X  4 , BR 

PC UP  74 

2036 

SX6  X6-1 

PCUP  75 

2037 

* 

LOAD  XI  WITH  THE  NUMBER  OF  BITS  TO  BE  SHIFTED 

PCUP  76 

2036 

0R  PX4  B0,X4 

PCUP  77 

2039 

NX4  X4 

PCUP  78 

2040 

F  XI  X3*X4 

PCUP  79 

2041 

* 

CONVERT  XI  TO  INTEGER  AND  SAVE  IN  02  FOR  LATER  USE 

PCUP  80 

2042 

UX1  02, XI 

PCUP  81 

2043 

L  XI  B2  ,  X  1 

PCUP  82 

2044 

SB2  XI 

PCUP  83 

2045 

* 

LOAO  THE  VARIABLE  OF  CORE  CONCERNED 

PCUP  84 

2046 

SA2  X6 

PCUP  85 

2047 

« 

SHIFT  THE  WORD  TO  ALIGN  PROPERLY  FOR  MASK 

PCUP  86 

2048 

LX2  B2,X2 

PCUP  87 

2049 

• 

COMPLEMENT  82 

PCUP  88 

2050 

SB2  -B2 

PCUP  89 

2051 

* 

FORM  A  59  BIT  MASK  IN  THE  LOWER  59  BITS  OF  X4 

PCUP  90 

2052 

MX4  59 

PCUP  91 

2053 

LX4  59 

PCUP  92 

2054 

* 

B2  NOW  HAS  THE  NUMBER  OF  BITS  PER  PACKED  WORD 

PCUP  93 

2055 

SB2  82*60 

PCUP  94 

2056 

* 

LOAO  XL  WITH  A  MASK  OF  l -S  WHOSE  LENGTH  EOUALS  THE  THIRD  ARGUMENT  - 

1PCUP  95 

2057 

A  X4  B6 , X  4 

PCUP  96 

2058 

SX5  1 

PCUP  97 

2059 

* 

X 6  HAS  A  MASK  FOR  SIGN  AND  VALUE 

PCUP  98 

2060 

1X5  X4*X5 

PCUP  99 

2061 

1X6  X4+X5 

PCUP  100 

2062 

* 

♦0  TO  UPK  IF  AN  UNPACK  IS  DESIRED 

PCUP  101 

2063 

EQ  81 , UPK 

PCUP  102 

2064 

* 

LOAO  XI  WITH  THE  VALUE  TO  BE  LOAOEO  INTO  CORE 

PCUP  103 

2065 

SA1  AO  *3 

PCUP  104 

2066 

S  A 1  XI 

PCUP  105 

2067 

# 

INSURE  THAT  VALUE  IS  NOT  TOO  LARGE  FOR  PROPER  PACKING 

PCUP  106 

2068 

BXO  XI 

PCUP  107 

2069 

PL  X  0 , CHK 

PCUP  108 

2070 

BXO  -X0 

PCUP  109 

2071 

CHK  1X0  X0-X4 

PCUP  110 

2072 

PL  XO , DMP 

PCUP  111 

2073 

* 

IF  VALUE  IS  NEGATIVE,  SET  SIGN  HASK  TO  ZERO 

PCUP  112 

2074 

NG  XI, SCH 

PCUP  113 

2075 

SX5  BO 

PCUP  114 

2076 

• 

AND  OUT  THE  VALUE  TO  BE  PACKED  INTO  XI 

PCUP  115 

2077 

SCH  B  X 1  X1*X4 

PCUP  116 

2078 

* 

OP  THE  SIG5  INTO  XI 

PCUP  117 

2079 

B  XI  X 1  +  X  5 

PCUP  118 

2060 

• 

COMPLEMENT  X6 

PCUP  119 

2081 

BX6  -X6 

PCUP  120 

2082 

* 

ZERO  OUT  THE  BITS  INTO  WHICH  THE  PACKED  VALUE  IS  TO  BE 

INSERTED 

PCUP  121 

2083 

BX2  X2*  X  6 

PCUP  122 

2084 

* 

OR  THE  PACKEO  VALUE  INTO  A  60  BIT  WORD  AT  THE  PROPER  LOCATION 

PCUP  123 

2085 

BX2  XI *X2 

PCUP  124 

2086 

♦ 

SHIFT  THE  60  BIT  WORD  TO  REALIGN  WITH  CORE 

PCUP  125 

2087 

LX6  B2,X2 

PCUP  126 

2088 

* 

STORE  THE  60  BIT  PACKED  WORD  IN  CORE 

PCUP  127 

2069 

* 

THE  FUNCTION  RETURNS  A  60  BIT  PACKEO  VALUE 

PCUP  128 

2090 

S  A6  A2 

PCUP  129 

2091 

♦ 

RESTORE  AO 

PCUP  130 

2092 

S  A  0  B7 

PCUP  131 

2093 

* 

BRANCH  OUT  OF  THE  ROUTINE 

PCUP  132 

2094 

ZR  PACK 

PCUP  133 

2095 

UNPK  BSSZ  1 

PCUP  134 

2096 

IUNPK  EQU  UNPK 

PCUP  135 

2097 

* 

SET  FLAG  TO  INOICATE  AN  UNPACK  INSTRUCTION  IS  DESIRED 

PCUP  136 

2098 

SB1  BO 

PCUP  137 

2099 

ZR  INIT 

PCUP  138 

2100 
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1  OR  THE  60  BIT  WORD  OF  CORE 

TO 

REMOVE  1  PACKEO  VALUE 

INTO  X6 

PCUP 

139 

UPK  BX6 

X2*X4 

PCUP 

140 

OR  A  60  BIT 

WORD  TO  REMOVE 

SIGN  OF  PACKEO 

WORD  INTO 

X5 

PCUP 

141 

BX5 

X5*  X  2 

PCUP 

142 

1  COMPLEMENT 

VALUE  IF  SIGN  N»SK 

INOICATES  a 

NEGATIVE 

VALUE 

PCUP 

143 

ZR 

X5,SC 

PCUP 

144 

BX4 

-  X  4 

PCUP 

145 

BX6 

X4+X6 

PCUP 

146 

1  RESTORE  A0 

PCUP 

147 

SC  S  A0 

87 

PCUP 

146 

1  BRANCH  OUT 

of  the  routine 

PCUP 

149 

ZR 

UNPK 

PCUP 

150 

*  GENERATE  A  DAYFILE  MESSAGE  AND  ABORT  JOB  IF  AN  INTEGER  TO  BE  PCUP  151 


*  PACKED 

IS  TOO 

large  for  the  specified  bit 

pattern 

PCUP 

152 

PKHSS 

DATA 

C*VALUE  TOO  LARGE  TO  PACK* 

PCUP 

153 

DMP 

MESSAGE 

:  PKMSS,,1 

PCUP 

154 

AB 

ABORT 

PCUP 

155 

*  ENTRY 

POINT  TO  ABORT  JOB  AND  EXECUTE  EXIT 

CONTROL  CAROS. 

PCUP 

156 

ABT 

DATA 

0 

PCUP 

157 

EQ 

AB 

PCUP 

150 

END 

PCUP 

159 

IOENT 

CORS 

CORS 

2 

ENTRY 

CORSIZ 

CORS 

3 

VFD 

36/6HCORSIZ,24/0 

CORS 

4 

USE 

// 

CORS 

5 

A 

BSS 

1 

CORS 

6 

USE 

/K/ 

CORS 

7 

BSS 

7 

CORS 

6 

KORE 

BSS 

1 

CORS 

9 

CM 

BSS 

1 

CORS 

10 

USE 

0 

CORS 

11 

CORSIZ 

DATA 

a 

CORS 

12 

MEMORY 

CM, STATUS, 1 

CORS 

13 

SXO 

18 

CORS 

14 

S  A3 

STATUS 

CORS 

15 

1X6 

X3-X0 

CORS 

16 

LX6 

30 

CORS 

17 

SA6 

CM 

CORS 

IS 

SX5 

A 

CORS 

19 

1X6 

X6-X5 

CORS 

20 

SA6 

KORE 

CORS 

21 

EQ 

CORSIZ 

CORS 

22 

STATUS 

data 

0 

CORS 

23 

END 

CORS 

24 

2101 

2102 

2103 

2104 

2105 

2106 
2107 
2106 

2109 

2110 
2111 
2112 

2113 

2114 

2115 

2116 
2117 
2116 

2119 

2120 
2121 
2122 

2123 

2124 

2125 

2126 
2127 
2126 

2129 

2130 

2131 

2132 

2133 

2134 

2135 

2136 

2137 

2138 

2139 

2140 

2141 

2142 

2143 

2144 
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APPENDIX  B 

LISTING  OF  THE  MACHINE-INDEPENDENT  VERSION  OF  BANDIT 


c 

BANDIT  5 

1 

C  B  A  N  0  I  r 

BANDIT  b 

2 

c 

BANOIT  7 

3 

C  MAIN  PROGRAM  FOR  THt  RENUMBERING  OF  NASTRAN  GRID  POINTS  FOR 

BANDIT  A 

4 

C  RfcOUCtU  BANDWIDTH. 

BANDIT  9 

5 

C  THE  NASTRAN  DATA  OECK  MUST  CONTAIN  A  BEGIN  BULK  CARU  IN  ITS 

8ANDIT10 

6 

c  proper  place  ano  terminate  with  an  enjdata  card. 

8AN0IT11 

7 

DIMENSION  A ( 20 ) 

BANDIT12 

8 

COMMON  KOM ( 250 0 0 } 

JJ  1 

9 

COMMON  /S/  NN,MM,IH»I8 

BANDIT 1 4 

10 

COMMON  /P/  IMOtlHE 

BANOIT 15 

11 

COMMON  /A/  MAXGRO,HAXOEG,<HOO,NMPC 

BAND  I  T 16 

12 

COMMON  /d/  IPARAM(20> , 1ARG(5) 

BANDIT17 

13 

COMMON  /O/  IWARN,L INE  »KORlG*  KNEW 

BANDIT18 

14 

COMMON  /</  11(7) ,KOkE,IFL 

BAND I T 1 9 

15 

COMMON  /BITS/  NB I T IN, Nd 1 TE X, I P ASS 

BAND I T2  0 

16 

common  /time/  $ti.me,ncomp 

BANOIT21 

17 

COMMON  /NEL/  NEL , T IM2 

3ANDIT22 

18 

COMMON  /JOL/  IsTART(iOO) ,IGNORE(100> ,IFIRST(100) 

BAND IT23 

19 

COMMON  /DULL/  IUIM,ISTA , IIG, IFIR,IGOEG, ISCH 

BANUIT24 

20 

COMMON  /ZERO/  KT 

0ANOIT25 

21 

COMMON  /NG/  NGRIO, CLOCK 

BANDIT26 

22 

INTEGER  EOF 

D  ANO I T2  7 

23 

DATA  BEG  I »  L  NO J »  SEdG/4Hd  EGI » 4HENi)0,<*HS£uG/ 

BANDIT28 

24 

C  SET  NGRIO  UEFAULT. 

BANDIT  35 

25 

KORE=  25  0  J  d 

JJ  2 

2b 

NGRIO  -  KORE/28 

JJ  3 

27 

C  SET  SCHEME  DEFAULTS. 

8ANDIT38 

28 

IARG ( 1 ) =  30 

B ANO I Tj  9 

29 

IARi>(  2)  =1 

BANDIT40 

30 

IARG( 3) =2 

BANDIT41 

31 

IARG ( 4 )  =  2 

BANDIT«*2 

32 

IARG< 5) =3 

B  AND  I Th  3 

33 

C  SET  NUMBER  OF  BITS  PER  WORu  FOR  INTERNAL  AND  EXTERNAL 

BANDI  T*+4 

34 

C  GRID  NUMBERS. 

JANDIT45 

35 

NBITIN=12 

BAN0lT4b 

3b 

NBITEX=60 

BAND I T  4  7 

37 

7  FORMA  T  <  HI ,  16(/) , 

BAND  I T4  8 

38 

1  3bX , 57HBBB  u JB  AAAAA  N  N  JDDdDO  1 1 1 1 1 X I 

TTTTTTT/8ANOIU9 

39 

2  3bX,  57H  J  BA  ANNNJ  0  I 

T 

/BANUIT50 

40 

3  3bX, 57H  »  B  A  ANNNO  0  I 

I 

/BANDII51 

41 

4  36X,  57HdBdOdJ0  A  ANNNl)  0  I 

T 

/BANDI T  92 

42 

5  3bX,  57HB  B  AAAAAAA  N  N  N  J  D  I 

T 

/OANDIT53 

43 

6  3oX, 57H  i  UA  ANNNO  D  I 

T 

/UANDI.T54 

44 

7  3o  X , 57H  BdHbBB  A  AN  N  JDuUOD  1 1 1 II 1 1 

T 

) 8ANUIT5S 

45 

8  FORMAT(22(/) , 4 8  a , 3 4HT HE Okf  OF  STRUCTURES  BRANCH  -  1844  / 

JJ  4 

4b 

1  46X , J8HC0MPUTAT ION  AnD  MA  THE  MA  T IC  3  UEPA  RT  rtENT  / 

JANDIT57 

47 

2  *«4X  ,  •♦2HN  A  V  AL  SHIP  RESEARCH  AND  UEVELUPMENT  CENTER  / 

BANDI T  5  8 

48 

3  53X ,24H8LTHE5UA,  MARYLAND  20034  ) 

BAND  I  T6  9 

49 

9  FORMAT ( /  57X  , 

JJ  5 

50 

f  16HREV.  1U  MAR  1 972  ) 

BANDIT61 

51 

10  FORMAT (20A4) 

dANDITo2 

52 

11  FORMA  T ( H  , 2 0  A 4  > 

BANDIT63 

53 

12  FORMAT  (HI) 

B  ANO I T  o4 

54 

13  FORMA T(///2bH  TOTAL  CP  TI1E  IN  B ANO I T  ,F9.3,6H  SEC.) 

JJ  D 

55 

L I N£=  55 

BANDI Tob 

5o 

KNE  W  =  0 

BANdlTb7 

57 

REWIND  8 

BANOITbB 

5  8 

C  PRINT  TITLE  PAGE. 

BANL)ITo9 

59 

WRITE (6, 7) 

BANDIT70 

bO 

WRITE (b,  8) 

BANDI T7 1 

61 

WRITE (6,9) 

BANDIT7  2 

62 

C  INITIALIZE  VARIABLES. 

BANDI T7  3 

o3 

00  15  J= 1 , 20 

BANUIT74 

o4 

15  IP  A  RA  M  (  J )  =  0 

oAiNDI  T  7  5 

65 

IPARAM (12) =4 

B  AND I T  7o 

bb 

I0IM= 100 

BANDIT77 

b  7 

1ST  A  =  0 

BAND  IT  7  8 

68 

1 1  G  =  0 

OANDIT79 

69 

ISCH=0 

BANDIT80 

70 

I F 1  R=  0 

BANUIT81 

71 

IGDEG  =  0 

BANDI Tfl2 

72 

Do  18  1=1,  ion 

BANUIT83 

73 

ISTART(I)=0 

B ANO  I  T  8  4 

7  4 

IFIRST (I)=0 

BAND  I  T 

73 

18  IGNORE ( 1 )=  0 

BANDI T8G 

76 

IPA  SS  =0 

BANDIT87 

77 

NN=  0 

OANDlTaa 

78 

,MM=  J 

UANUIT89 

79 

MAXGR J=0 

BAND  I T  90 

80 

MA  X  OE  0=  0 

BANDIT91 

81 

KMOO=d 

BANDI T92 

82 

KOR IG  =C 

BANDIT  93 

83 

KNE  W=  0 

BANDIT  94 

84 

ST  I  ME  =  0 . 

BANUIT95 

85 

NCOMF  =0 

dANDI T96 

86 

NEL  =  0 

BANDIT97 

.8  7 

KT=  0 

BANDIT  98 

88 

TIM2=  0 . 

0ANDIT99 

89 

REWIND  9 

BAND  1 10 J 

90 

G  R  E  A  J  OECK  FOR  FIRST  TIMi_. 

BANDI 101 

91 

CALL  GOOGAN (1,2,5, 9) 

o  And  no  2 

92 

C  SLICE  UP  CORE  A CCORU I NG  Td  SUBROUTINE  GRID. 

BANDI1JS 

93 

K2=  1 1  (1)  *11  (2)  +1 

BANDI 104 

94 

K3=K2+1I (3) *2 

BANDI 10  5 

95 

K4=K3+ I I (h) 

BANUIlUb 

96 

K5  =  K4  + 1 1  (•?) 

BANDI 107 

97 

K6  =  K5 ♦ 1 1 (b> 

BANDI108 

98 

K7  =  Kd  + 1 1  ( / ) 

BANUI1J  9 

99 

C  PROCESS  DECK. 

BANDI 110 

loo 
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CALL  NAS MUM ( KOM ( 1 ) , II (1 ) , KOM < K2) , II ( 3) , KOM ( K3) ,K0M(K4> ,K0M(K5>, 
f  KOM ( <6)  ,KQH(<7)  ,KOM(l)  ,  KOM  ( K2 )  ) 

C  ARRAY  STARTING  AT  LOCATION  K7  HAS  DIMENSION  2*  MAXDEG 

C  PROCESS  OUTPUT  ACCORDING  To  OUTPUT  REQUESTS. 

C  CHECK  IF  CONNECTION  CAROS  IN  DECK. 

IF  ( IPARAM(9) . EQ • 3 ) GO  TO  19 

REWIND  8 

REWIND  9 

FLAG*ENOD 

J*  0 

K*9 

GO  TO  20 

19  REWIND  8 
J*  0 

K*8 

FL AG-ENOO 

IF(IPARAM(5) .EQ.4)GO  TO  20 
K«9 

IF(IPARAM(6).EQ.3)FLAG=3£GI 

20  RE A 0 ( K , 10) A 

IF (EOF <K) . Nt • 0  >  CALL  BOMdlT(l) 

J*Jfl 

IF (IP  ARAM (10) .EQ. 5. AND. A (1 ) . NE.SEQG)  J*J-1 
IF <MOO(J,llME) .EQ. 1) WRITE (6, 12) 

IF( IPARAM(IO) .tQ.b)  WRITE(6,U)  A 

IF  <  IP  AKA  .1(10)  .EQ.3.ANJ.  A  (  1)  .EQ.SEQG)  WRITE  (6,11)  A 

IF  (IP  ARAM ( 1) ,£Q. 2) WRITE (7, 10) A 

IF(IPARAM(l).tu.l.ANO.A(l) .EQ.SEQG)  WRITb(7,10)  A 
IF(K.NL.i)  WRIT  E (8,10)  A 
IF  (A(  1)  .Nfc.FLAOGO  To  20 
IF  (FLAG. cj. LNOU) GO  TO  25 

flag=endj 

K=  5 

GO  TO  20 
25  CONTINUE 

IF(IPARAN(5) ,£Q.3)GO  To  60 
IF(IPARAM(7).  tli .  4)  GO  TO  60 
IF(IPAKAM(9) .EG.4)G0  TO  60 
i  USER  SUMMARY. 

WRITE (6,50)  KORIG, KNEW 
50  FORMAT(23Hl***bANJIT  USER  SUMMARY  / 

1  6X  ,2  5HO RIG INAL  SEMI- BANDWIDTH  ,19/ 

2  8X , 2 0HNEW  StMI-BANUWIOTH  ,114) 

WRI TE  (6, 11 7 )  IH0,IHE 

117  FORMA T(8X,18H0RIGINAL  PROFILE  , I16/8X, 13HNEW  PROFILE  ,121) 
WRITE (6,104)  MN 
WRITt(byllj)  NEL 
WRITE  (6,112)  NCOMP 
WRITE (6,107)  MM 

107  FORMAT (8X,22HMAXIMUM  NOOAL  DEGREE  ,112) 

WRI TE (6 , 1 lo  )  KT 
I  =  I  PA  RAM  ( l ) 

IF(I.EQ.l)  WRITE (6,101) 

IF ( I. Eu. 2)  WRIT  E (6 , 102) 

IFCI.tQ.J)  WRlTE(6,10i) 

101  FORMAT (9X,34H PUNCH  OUTPUT  SEQGP  CAROS  ) 

102  FORMAT (8X, 34HPUNCH  OUTPUT  ALL  CAROS  ) 

10a  FORMAT  (8X,3»»HPUNCH  OUTPUT  NONE  ) 

WRI  TE  (6, 1J5)  .MAXGRDjMAXOEG 
105  FORMAT (18X, 8MMAXGRJ  , 1 1 1/ 18 X , 8H M AXOfcG  ,111) 

111  F0RMAT(6X,14MJATE  AND  TIME  , 2A10) 

C  I  PA  3  S=  NUM  Jt  R  OF  PJUP  C  All'S. 

104  FORMAT  (8X,23.HNUMB£R  OF  GRID  POINTS  ,111) 

113  FORMA  T ( 8  X , 2  OrtNUMdE  R  OF  ELEMENTS  ,114) 

112  FORMA  T ( 6X,22HNUMdER  OF  COMPONENTS  ,112) 

llo  FORMAT  ( d  <, 28HN0 •  OF  POINTS  OF  ZERO  Oc.GREt  ,16) 

GO  TO  70 

6d  IF ( IP ARAM ( 10 ) .EQ.5)  WRITE(6,12) 

70  CONTINUE 
REWIND  8 

IF (IPARAM(d) .lQ.4)  STOP  5 

STOP 

END 

SUBROUTINE  NASNUM (IG,  IIlylNV,  1 13  ,  IN  T  ,ICC,ILO,NOKlG,  IP,  Jo  ,  JN  V) 

JI MEN SI JM  A (3) ,<o(4d> ,LG(40) , LINE (10) ,J (20) , ATEMP(4) 

DIMENSION  IG( 111,1) ,INV (113,2)  ,JG(1> ,JNV(1) 

DIMENSION  InT(1) ,ICC(1) , ILJ< 1) ,NORIG(l) ,IP(1) 

C  IP  HAS  D lie N S I U N  2*MAXJEG.  JG  AND  JNV  ARE  EQUlV  TO  IG  ANO  INV. 
COMMON  /S/  NN, MM ,  I H, I B 
COMMO  (  /  A/  MAXGRJ,MAXJEG,<MOO, NMPC 
COMMON  / J/  IPARAM(20) ,IARG(5) 

COMMON  /C/  lWARN,NLIN£,KORIG,KNEW 
COMMON  /UTS/  NJlTlN, HJlTEX, IPASS 
COMMON  /</  II (7) , KORE 
COMMC  i  /TIME/  TIM2, NCOMP 
COMMON  /Ail/  NLL 

COMMON  /JOL/  IjTART(IOO) ,IGNORE(100) ,IFIRST(100) 

COMMON  /JOLL/  I0IM,ISTA, IIG, IFIR, IGOEG,ISCH 
C  TH.L  VARIABLE  LINE  UEFINEO  NEAR  CARD  NASNUM. 3U0  IS  NOT  THE 
C  SAME  AS  TrtE  VARIABLE  LINE  APPEARING  IN  COMMON 

C  IN  OTHER  ROUTINES. 

UlMENSIO  \  TYPE(5d)  ,WYPE(5J) 

JlMiNSlON  F 1 A (2 ) ,  F10  A (2 )  ,F16(2),F10S(2) 

DATA  31 G I, t  NOD, SEJG/4HUEGI »4HENOC,4HS£QG/ 

DATA  TYPE/4HC.»AR,**HC£LA  ,4HCELA  ,<*HCONK,4HIQOH  ,4HCQDP  ,4HCQJA, 

1  4MCuUA,t,HCJUA,<*riCROD,  4HCSHE,4HCTRB,fHCTRI  ,4HCTRI,4HCTRM, 

2  4HCTRP,4MCrUo,4HCTW: ,4HENJQ,4HMPC*,4HCDAM ,4HC JAM , 4HC MAS, 

3  4HCMAS,4HCVIS,<4HCJAM,4HCOAM,4HC2LA,4HCELA,4HCMA3,4HCHAS, 

4  4HGCUN, 4 HOT  OR, 4HCTRA , 4HCTRI ,4HC0NM, 4HC0NM ,4HCHTT ,4HC IS3, 

5  4HCIS  3,4HCIS2,4HCI S2 ,4HCISH ,4HCI SH, 4 HCF LU ,4HCFL U , 4HCFu U, 


BAND I 11 1 
BANOI 11 2 
0ANDIU3 
BANOI 114 
BANOI 115 
BANDI116 
BANOI 117 
BANOI11A 
BANOI 11 9 
BANOI 120 
BANOI 121 
BANDI122 
BANOI12  3 
0  AND 1 124 
BAN0I125 
BANOI126 
BANOI 12  7 
BAN0I128 
BANOI 129 
BANOI 130 

BAND  1131 

BANOI 132 
bANOIlSJ 
BAND  1134 
BANOI 135 
BAN0I1J6 
B  AND  1 13  7 
BANOI 13d 
BAND  1139 
8  AND  1 1  <f0 
BAND  1141 
BANOI 142 
BANOI 143 
BANDI144 
JJ  7 
BANDI147 
BAND 1148 
bANDIl<*9 
BANDJ150 
JJ  d 
BAND 1152 
JJ  9 
JJ  Id 
BANOI 15o 
JJ  11 
BANOI 15d 
BANOI 159 
B AND I lo  0 
BANDIlol 
JJ  12 
BAND I 163 
bANOI 1o4 
d  AND I 1d5 
BAND  1 16  b 
BAND 1 16  7 
BANOI 168 
8ANDI169 
BANOI 17 J 
B ANDI 1 7  2 
JJ  13 
BANOI 17  7 
BANuIl/8 
JJ  14 
JJ  15 
JJ  IS 
JJ  1* 
uANOI 184 
BAND  1 185 
BAND 1187 
BANDI188 
BANUI190 
B ANDI 19 1 
BANOI 192 
NAaNUM  2 
NASNUM  3 
NASNUM  4 
NASNUM  5 
NASNUM  6 
NASNUM  7 
NASNUM  8 
NASNUM  9 
NASNUM10 
NASNUM11 
NASNUM12 
NASNJM13 
NASNUM1-* 
NASNJM15 
NASNUM16 
NASNUM1 7 
NASNJM18 
NASNUM19 
NASNUM20 
NASNJM21 
N ASNUM22 
NASNJM23 
NASNUH24 
NASNUM26 
NASNJM26 
NASNUM27 
NASNJM28 


101 

102 

103 

104 

105 

106 

107 

108 

109 

110 
111 
112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

12o 

127 

128 
129 
13  U 

131 

132 

133 

134 

135 
13b 
137 
lod 
109 

140 

141 

142 

143 

144 

145 
14b 

147 

148 

149 
15d 

151 

152 

153 

154 

155 

150 

157 

168 

159 

160 
161 
lb2 
163 

lb4 

lo5 

166 

167 

lb8 

169 

170 

171 

172 

173 

174 

175 
17b 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 

193 
1*94 

195 

196 

197 

198 

199 

200 


49 


b  4HCTE  T,4MCHtX  ,4HCHEX/ 

DATA  WYPE/4M*  ,4HS1*  ,4HS2* 


4HD2*  ,4HU3*  ,  4H*  ,4HAR*  ,4HSC 
4HLT*  »  4  H  E  •  ,4HST*  ,4HATA  ,4H 
4HS2*  ,4  H**  1 4  HP3  *  ,4HP4*  ,4hS3 
4H£AX*,4HDR0* ,4HPRG*  ,  4HARG*  ,  4H1* 


t  *♦  HEM*  f4HLT*  ,4H0l* 


,4HAR*  ,4HSC*  ,  4HA1*  ,4HA2*  ,4HEM* 
,4HATA  ,4H  ,4HP1*  ,4HP2*  ,4HSi* 
»4HP4*  ,4mS3*  ,4HS4*  ,4MS3*  ,4HS4* 


,4HRI2* ,4HD8* 


5  4H  0?  0  * , 4HD4*  ,4HI)d*  ,4H8*  »4H16*  , 4 H 102* , 4H I  03* , 4H I  04* , 

6  4HRA*  ,4HA1*  , 4HA2  *  / 

NT Y  PE  =  50 

REHINJ  8 
REWIND  9 
NMPC=  40 

KHOj=2.*FuOAT ( M A XGRD) -2 . 27  15 *SQRT < 1 . 1 Jl * F L OA T (M A XGRO) ) 

NE  W  =  0 
tWARN=C 
NEQ  =  0 

2  FORMA  r<29rll  JANUIT  INFORMATION  MESSAGE  -  / 

♦  19H  90  GRIu  POINTS/ 

♦  28H  <tSE  J’JENCING  SUPPRESSED) 

4  FORMA  T (  19H  ***NLW  BANDWIDTH  =,I6> 

5  FORMA T(3 iHITHt  WRONG  CARO  FOLLOWS  THIS  CARD/ IX  ,  2 A4 , lP4t lb. 7 ,2A4// 

2  4  0  H  THE  CONTINUATION  CARO  IS  RE JUIREO’ NE X T  , 

3  3cH  S I NCE  BANDIT  JOES  NOT  SORT  TrtE  DECK.  / 

4  13H  FATAL  ERROR.  ) 
o  FORMAT(lHl) 

7  FORMAT  (5-*  HI  ONE  OR  MORE  SEQGP  CAROS  ALREADY  APPEAR  IN  DATA  DECK./ 


NASNUM29 
NASNUM3Q 
NASNJMJ1 
NASNUM32 
NAiNUM33 
NASNUM34 
NASNUM35 
NASNUMJo 
NASNUM37 
NASNOM38 
NASNUM39 
NASNUM40 
NASNUM41 
N ASNUM4  2 
NASNUM43 
NASNUM44 
N AS  NUM4  5 
N ASNUM4  o 
NASnUM47 
NASNUM48 
NASNUM49 
NASNUM? J 
NASNUM51 
NASNUM52 
NASnUMSJ 
NASNUM54 


*  55H  REsl QUENCING  CANNOT  BE  REQUESTED.  FATAL  ERROR.  ) 

8  FORMA  T  <&HSEQGP»3X|2I8  »56X) 

9  FORMAT  (20A4). 

1J  FORMAT (2Ah# 4Flb. 0, 2A4) 

11  FORMAT (1M  ,5(18,  Ill, 7X) ) 

12  FORMAT  (5Hs>EuGP»3X,8I8  ,dX) 

14  FORMAT (Z///26H  ***0AN0IT  WARNING  MESSAGE  / 

1  11X, 35H  THE  WRONG  CARO  MAY  FOLLOW  THIS  CARO  / 

2  1  IX  ,2A*,,  1P4E16. 7 ,2A4/ 

3  11X , V7HCHECK  INPUT  OECK  TO  Ut  SURE  THAT  A  CONTINUATION  , 
h  42H  oft RU  IS  NEITHER  MISSING  NOR  OUT  OF  SORT,  ) 


N A  SNUM5  5 
NAiNUMSb 
N  ASNUM5  7 
NAbNUM58 
N ASNUMb  9 
NASNUMo 0 
NASNUM61 
N A  SNUMb  2 
N  ASNUMb  3 
N A  SNUMo  4 
NASNUMb5 


21)  1 
2U2 

203 

204 
2  0  j 
2Ub 

207 

208 

209 
21  U 
211 
212 

213 

214 

215 

210 

217 

218 

219 

220 
221 
222 

223 

224 

225 
22d 

227 

228 

229 

230 

231 

232 

233 

234 

235 

236 

237 


15  FORMA  T ( 2oh  TOTAL  CP  TIME  IN  SCHEME  =  ,F9.3,bH  StC.  ) 

N ASNUMb  6 

238 

19  FORMAT  (Hl,5(20HlNTcRNAL  OR  IG  I  NAl  ,  6  X  )  / 

NASNUM67 

239 

11H  ,5(20HoRlO  NO.  GRIO  P  T  .  , 6X  > ) 

NASNUM68 

240 

C  RETJRN  IF  RtSEuUtNCING  IS  NOT  OESIRtO. 

N ASNUMb  9 

241 

IF <  IP  ARAN (6) .EQ. 3) RETURN 

NASNUM70 

242 

C  CHECK  IF  SCOOP  CARDS  ALREADY  APPEAR  IN  DECK. 

NASNUM71 

243 

lFUPARAim.2U.3IGO  TO  22 

NASNUM72 

244 

C  AduRT  BANDIT  SInCc  SEQGP  CAROS  ALREADY  APPEAR  IN  DECK. 

NASNUM73 

245 

WRI  TE  <b,  7) 

NASNUM74 

24b 

CALL  90M  31 T ( 3 ) 

NASNUM75 

247 

C  READ  ANO  EXTRACT  CONNECTION  CAROS  FROM  DECK. 

NASNUM76 

248 

22  CALL  jOOGAN ( 2, 1 , 9, 3 ) 

NASNUM77 

249 

REWIND  8 

NASNUM78 

250 

REWINO  9 

NASNUM79 

251 

C  INITIALIZE  EXPANDABLE  CORE. 

NASNUM80 

252 

OO  30  1=1, KORE 

NASNUM81 

253 

30  J& ( I ) =0 

NASNUM82 

254 

C  READ  CARD. 

NASNUM83 

255 

40  REA 0(6,1 J)F1A, <A(I),I=l,4),F10A 

NASNUM8+ 

25o 

C  DETERMINE  CARD  TYPE. 

NASNUM85 

257 

45  I T  YPE  =0 

NASNUM36 

258 

DO  50  I=1,nTYPE 

NASNUH87 

259 

5 0  IF(F1A(1) .LQ.TYPE(I) .ANJ.F1A (2) .EQ.WYPE (I) )  ITYPE  =  I 

NASNUM8  8 

260 

IF (ITYPE.tU.U)GO  TO  40 

NASNUM89 

261 

IF ( IT  YPt , EU. 19) GO  To  5U0 

NASNUM90 

262 

IF(ITYPE.EU.20.ANJ.IPARAM(4),EQ.3)GO  TO  40 

NASNUM91 

263 

C  READ  CONTINUATION  TO  CARO  DUST  READ. 

NASNUM92 

264 

REAJ(8,lJ)Fld,(A(I),I=5,8),F10B 

NASNUM9J 

265 

C  CHECK  EACH  LOGICAL  CARD  FOR  PROPER  SORT. 

NASNUM94 

266 

IF ( FI d( 1 ) .EQ.FlOA(l) ,ANO.F1U(2).EU.F10A(2) I  GO  TO  60 

NASNUM95 

267 

C -  IF  FOLLOWING  CARD  TYPES  ARE  OUT  OF  SORT,  NO  ERROR 

NASNUM96 

2b  8 

IF (ITYPl.EQ.1. OR. ITYPE.EQ.4)G0  TO  56 

NASNUM97 

269 

IF(  ITYPE . EQ.32) GO  TO  56 

N  ASNUM96 

270 

IF(ITYPL.EQ.33)G0  TO  5b 

NASNUM99 

271 

IF  ( IT YPE »£u* 35) GO  TO  5b 

NASNU100 

272 

IF  (ITYPE ,EU.3d> GO  TO  5b 

NASNU101 

273 

IF (ITYPE. EG. 37)GO  To  56 

NASNU102 

274 

IF  < ITYPE. Ed. 45. OR. ITYPE. EQ. 46)  GO  TO  56 

NASNU  10  3 

275 

C“"  IF  FOLLOWING  CARD  TYPES  ARE  OUT  OF  SorT,  POSSIBLE  ERROR  (GIVE 

NASnUIO  4 

276 

C -  WARN INo  MESSAGE) 

NASNU10  5 

277 

IWARN=IWARN+1 

NASNU106 

278 

IF (MOD (I  WARN, 6) .EQ.l) WRITE (6,6) 

NASnUIO  7 

279 

IF (ITYPE. tU.  2)  bO  TO  54 

NASNU108 

280 

IF  (ITYPE  «£Q.  3)  GO  TO  54 

NASNUIO  9 

281 

IF(ITYPE.EU.lu)  GO  TO  54 

NASNU110 

282 

IF ( ITYPE • EQ • 17)  GO  TO  54 

NASNU 11 1 

283 

IFUTYPE.Gt.  21.  AND.  ITYPE.  LE.3DG0  TO  54 

NASNU112 

284 

C -  FOR  OTHER  CARO  TYPES  OUT  OF  SORT,  ABORT  BANDIT 

NASNU113 

285 

52  WRITE (6, 5) FI A,  ( A  < I > ,1  =  1,4)  ,F10A 

NASNU114 

28b 

CALL  DOMd I T ( 2) 

NASNU115 

287 

54  WRITE  <6, 14) FI  A, (A( I) , 1=1,4) , F10A 

NASNU 1 lb 

288 

C  SAVE  CONTENTS  OF  THE  SECOND  CARD  OF  THE  PAIR. 

NASNU11 7 

289 

56  DO  58  1=1,4 

NASNUU  8 

290 

ATEMP(I) =A ( I +4 ) 

NASNUU9 

291 

53  A ( 1  +  4 )  =  0 . 

NASNU120 

292 

C  INI! IALIZE  KG  AND  LG. 

NASNU 12  1 

293 

bO  00  70  I  =  1 , NMPC 

NASNU122 

294 

KG ( I ) =0 

NASN^123 

295 

70  LG ( I ) =0 

NASNU124 

296 

LOOP=l 

NASNU125 

297 

NCO  N=  4 

NASNU12o 

298 

C  SET  UP  KG  ANO  LG.  ** 

NASNU127 

299 

GO  TO  (160,220, 220,200, 120,120,120,120, 120,180, 120,140 ,140, 

NASNU128 

300 

50 


1  14J,l4ii,l40,18Q,l2J,500,230,220,2201 

>220,220,180,180, 

NASNU129 

301 

2  i8J,ia0,i80,ldJ,l3J,lb0,lb0,ii0,ll4, 

,118,118,140,  60, 

NASNU13U 

302 

3  85,120,  90  »  80,  95 , 2  0  0 , 1 14, 110 , 120  , 

,  90, 

90) ,11 YPl 

NASNU131 

303 

C*  C  IS  3l)8  ,  C ISH  3 

NASNU132 

304 

80  00  81  1=1,7 

NASNU133 

305 

81  KG ( I ) =A ( I+i) +0. 5 

NASNU134 

306 

NCON=3 

NASNU135 

307 

RE  AO (9, 101  F1A,A(1) ,  A  (  2  ) ,  A  (3  > »  A ( 4 ) , F 1 0  A 

NASNU136 

308 

IF  (FI  A(l)  .NE.FlUid>.3R.FlA<2>  .NE.F1QB(2>  ) 

GO 

TO 

100 

N ASNU137 

309 

KG ( 8 ) =A(l>+0.5 

NASNU138 

310 

#GO  TO  23  0 

NASNJ139 

311 

C*  CIS*3U2  0 

NASNUlnO 

312 

85  00  86  1=1,7 

NASNU141 

313 

86  KG(  I)  =A{  Id)  tO. 5 

NASNJ1**2 

314 

NCON= 20 

NASNU143 

315 

REAJ{ 8, Id)  FI A, A (1) , A (2) ,A (3) , A(4) ,F10A 

NASNU144 

316 

IF  (FI  4(1)  .NL. Fluiid). OR. F1A<2)  .Nil  .FI  Od  (  2 )  ) 

GO 

TO 

100 

NASNJ145 

317 

READ (8, 10)  Fid, A (5) ,A(o> , A (7) ,A<8> ,F10B 

NASNUl4o 

318 

IF(Fld(l)  .NL.FlijA(l)  .  OR  •  FlO  ( 2)  •NE«F10A(2>) 

GO 

TO 

52 

NASNU147 

319 

00  87  1=8,15 

NASNU148 

320 

87  KG(I)=A(I-7)+Q.5 

NASNU149 

321 

READ ( 8,1 j)  F 1 A , A ( 1 ) ,A(2) ,A(3) ,A(4) , F 1C A 

NASNJ150 

322 

IF4F1A(1)  .NE.FlUiMl)  .0K.F1A(2)  .NE.F10U(2) ) 

GO 

TO 

100 

NASNU151 

323 

READ  (  3 , 1 J )  FlD,A(5),A(G),A(7),A(8),F10i3 

NASNU152 

324 

IF(F18(1).N£.F1JA(1).JR.F13(2) .Nfc.FlQA(2) ) 

GO 

TO 

52 

NASNU153 

325 

00  88  1=16, 2U 

NASNU154 

32b 

88  KG(I)=A(I-15)+U.5 

N A  SNU 1?5 

327 

GO  TO  250 

N ASM 0 156 

32d 

C*  CIS208,CHtXAl, CHEXA2 

NASNU157 

329 

90  00  31  I=l,o 

NASNJ158 

330 

31  KG(I)=A(I+2)+0.5 

NASNU159 

331 

NCON=  8 

NASNU160 

332 

RCAD( 8, 10)  F1A,A(1),A(2) ,A(3),A(4),F104 

NASNJlol 

333 

IF(F1A(1)  .Ut.FlOB(l) .0R.FIAC2)  .NE.F1Q9(2)  ) 

GO 

TO 

100 

NASNU162 

334 

00  92  1=7,8 

NASNU163 

335 

92  KG(  I)  =  A  ( 1-6)  ♦  i)«  5 

NASNUlb4 

336 

GO  TO  253 

NASNU165 

337 

C*  C IS  HI  6 

NASNU166 

338 

95  00  9o  1=1,7 

NAoNU167 

339 

9o  KG(I)=A(I+l)+0.5 

NASNUlbd 

340 

NC0N=16 

NASN0169 

341 

RE AO (3,10)  F1A,A(1),A(2) ,A(3) , A ( 4 ) , F 1 0  A 

NASNJ170 

342 

IF ( FI  A (1 ) .Nt.FlOBd) . OR .F1A ( 2) .N£.F10B(2) ) 

GO 

TO 

100 

NASNU17 1 

343 

RE A  0(8, 10)  FI J , A ( 5 ) ,A(o) ,4(7)  ,A(8),F10d 

NASNU172 

344 

IF (FI  3(1) .Nt.FlOA(l),OR*F13(2) .NE.F10A<2) ) 

GO 

TO 

52 

NASNJ173 

345 

JO  97  1=9,15 

NASNU17  4 

346 

97  KG(I)=A(I-7)+0.5 

NASNU175 

347 

RE  AO ( 9, 10)  F1A,A(1),A(2)  , A (3)  ,  A ( 4) , FlO  A 

N ASnOI 7  6 

348 

IF (FI A(ll .NC.FiOB(l) .OR. FI A (2)  .Nt.F10B(2) ) 

GO 

TO 

10U 

NASNU177 

349 

KG(i6)  =  Ad)+0.5 

NASND178 

350 

GO  TO  260 

NASNJ179 

351 

103  FlAd)=F10(l) 

NASNU18  3 

352 

FlA (2)=Flo(2> 

N A5NU16 1 

353 

00  131  1=1,4 

NASNU182 

354 

101  A(I)  =  A(I+«*> 

NASNU133 

355 

FlO A ( 1) =F10  J(1 ) 

N ASNU18  4 

356 

FI 0  A  ( 2 )  =FiOl3  ( 2  ) 

NASNU185 

357 

GO  TO  62 

NASNU186 

358 

C*  CTRAPRG,CFL JID4 

NASNU187 

359 

110  00  112  1=1,4 

NASNJ188 

360 

112  KG( I) =A(I+1)*0.5 

NASNU189 

361 

GO  TO  25Q 

NASNU19J 

3b2 

C*  CT.RIARG,OKlOIU3 

NASN0191 

363 

114  00  llo  1=1,3 

NASNU192 

364 

lib  KG  ( I )  =  A  (  Id)  *0.5 

N ASNU193 

3b5 

GO  TO  250 

NASNJ194 

366 

C*  CON  HI ,  C3NM2 

NASNU195 

367 

11*  KG  (1)  =A  (  2) 

NASNU196 

368 

KG ( 2) =KG  (1) 

NASNJ197 

369 

GO  TO  250 

NASNJ198 

37Q 

C*  C JO HE M,C 3uPLT,CJuAJl,CJJA02,3QUA03,CSHtAR,CTHIST, 

cis2D4,:tetra 

NASNU199 

371 

123  00  13  J  1=1,4 

NASNU20 0 

372 

1 3  J  <G  ( 1 )  =  A  (  I  f  2  )  +0  •  5 

NASNU20 1 

373 

GO  TO  250 

NASNJ232 

374 

C»  CTRBSC,  CTRIAl,  ;Tk1IA2,  CTRKlH,  C Tit'Ll,  CHTTRI2 

NASNU203 

375 

14U  DO  150  1=1,3 

NASNU2J4 

376 

150  KG ( I) =A ( 1+2 )  ♦  0. 5 

NASNU205 

377 

GO  TO  250 

NASNJ206 

378 

C*  C9AR,  CCONEAX,  CTORORG 

NASNU207 

379 

160  00  170  1=1,2 

NASNU208 

380 

170  KG (I) =A(I+2>+0.5 

NASNU209 

381 

GO  TO  250 

NASNU210 

382 

C*  CROD,  CTJbE,  C VI3C,  COAHP3 ,  C  DA  MP4,  CEL ASS ,  CEL AS 4 , 

CHASS3,  CMASS4 

NASNU211 

383 

180  DO  190  1=1,2 

NASNU212 

364 

Kb(l) =A ( 1+2 ) +0 • 5 

NASN0213 

385 

190  LG( I) =A( 1+6) +0.5 

NASNU214 

386 

C  SET  LOOP=  2  SINCE  2  tLEHENTS  MAY  BE  DEFINED  ON  ONE 

CARD. 

NASNU215 

387 

LOOP=  2 

NASNU216 

388 

GO  TO  250 

NASNU217 

389 

C*  CONROO,CFLUIJ2 

NASN021d 

390 

2  0  J  DO  210  1=1,2 

NASNU219 

391 

210  KG( I> =A( I+l» +0.5 

NASNU220 

392 

GO  TO  250 

NASNU221 

393 

C*  CElASI,  CELAS2,  CuAHPi,  CUAMP2 ,  CMASSl,  CMASS2 

NASNU222 

394 

220  KGd)  =A(3)  +  0.5 

NASNU223 

395 

KG ( 2) =A(5) +0.5 

NASNU224 

39b 

GO  TO  250 

NASNU225 

397 

C  PROCESS  MPC  CARDS. 

NASNU226 

398 

230  NCO N=  NMPC 

NASNU227 

399 

KGd)  =A  (2)  +0*  5 

NASNU228 

400 

51 


KG(2)=A(5)*Q.5 

NASNU229 

401 

1*2 

NASNU230 

402 

240  REA0(8, 10)F1A, (A(J>, J*l,4) ,F10A 

NASNU231 

403 

IF (FI  OB ( 1) .NE.FlA(l) . OR.F1O0(2) .NE.F1A(2))  GO 

TO 

250 

NASNU232 

404 

1*1  +  1 

N ASNU233 

405 

IF  ( I « GT . NMPC) GO  To  245 

NASNU234 

406 

F10B( 1) *F10 A ( 1 ) 

NASNU235 

407 

F10B<  2)=F10A(2> 

NASNU236 

400 

KK  =  2 

NASNU2J7 

409 

IF ( MOD ( 1 » 2 ) .EQ.0)KK*1 

NASNU238 

410 

KG ( I) =A ( KK) +0.5 

NASNU239 

411 

GO  TO  240 

NASNU240 

412 

245  WRITE  <6, 24b)  NMPC 

NASNU241 

413 

246  FORMA  T ( 3  6H 1  AN  MPC  EQUATION  CONTAINS  MORE  THAN 

,15 

,  8  H  TERMS./ 

NASNU242 

414 

+  14H  FATAL  ERROR.  ) 

NASNU243 

415 

CALL  0OH3I T ( 5 ) 

NASNU244 

416 

C  PROCESS  KG  (AND  LG  IF  L00P=2>  ARRAY. 

NASNU245 

417 

250  00  48  0  KK  =  1 f  LOOP 

NASNU246 

418 

IF( KK.EQ.i) GO  TO  300 

NASNU247 

419 

00  260  1=1,4 

NASNU248 

420 

260  KG < I ) — L G  < I > 

NASNU249 

421 

0  SCATTER  SEARCH  ANO  CONVERT  KG  TO  TEMPORARY  SET  OF 

internal  numbers. 

NASNU250 

422 

300  CALL  SCAT(KG, NCON, NEW, INV, 113, NORIG) 

NASNU25 1 

423 

IF  < ITYPE.NE.2d)GO  TO  420 

NASNU252 

424 

C  SAVE  MPC  GRID  POINTS  FOR  lATER  PROCESSING  8Y  TIGER 

, 

NASNU253 

425 

NE  Q  =  NEQ  +  1 

NASNU254 

42b 

WRITE (ll)KG 

NASNU205 

42  7 

GO  TO  45 

NASNU256 

428 

C  FILL  CONNECTION  TABLE  ARRAY  IG. 

NASNU257 

429 

420  IENO=  NCON- 1 

NASNU258 

430 

NEL=N£L+1 

NASNU259 

431 

DO  450  1  =  1, IE  NO 

NASNU260 

432 

L=  I  +1 

NASNU261 

433 

OO  450  J=L , NCON 

NASNU262 

434 

450  CALL  SETIGCKG(I) ,KG(J) ,IG. Ill, NORIG) 

NASNU263 

435 

480  CONTINUE 

NASNU264 

436 

IF(Fia(l).tQ.F10A(l) . AnO.F1B(2).EQ.F10A (2) )  GO 

TO 

40 

NASNU265 

437 

IF (NCON. GE. 8)  GO  TO  40 

N ASNU266 

438 

F1A ( 1 ) =F 10 ( 1) 

NASNU267 

439 

FI  A  (2 ) =F1U  <  2) 

NASNU268 

440 

00  495  1=1,4 

N ASNU269 

441 

495  A ( I ) =  ATEMP < I ) 

NASNU270 

442 

FI  0  A  (  1 )  =  F 10  8  ( 1 ) 

NASNU271 

443 

F10A(2)=F109<2) 

NASNU272 

444 

,  GO  TO  45 

NASNU273 

445 

500  NN  =  NE  W 

NASNU274 

446 

IF(NEW.GT.O)  GO  TO  502 

NASNU275 

447 

WRITE (6,2) 

NASNU276 

448 

IPARAM(9)=4 

NASNU277 

449 

RETURN 

NASNU278 

450 

502  IF(IPARAM(4).EQ.3)G0  TO  505 

NASNU279 

451 

C  MODIFY  CONNECTION  TABLE  TO  ACCOUNT  FOR  MPC  EQUATIONS. 

NASNU28U 

452 

CALL  TIGER(NEU,1G, III, ILO, NORIG) 

NASNU28 1 

453 

NDE  P=  NN 

NASNU282 

454 

CALL  FIXII (IL0,NDEP) 

NASNU283 

455 

C  GENERATE  NEW  IG  AND  NORIC  ARRAYS. 

NASNU284 

45b 

505  CALL  0RIGIT (IG, III, INV, II3,INT , ICC, NORIG, IP) 

NASNU285 

457 

C  PRINT  INTERNAL/EXTERNAL  CORRESPONDENCE  TABLE. 

NASNU286 

458 

LEN=50 

NASNU287 

459 

IF ( IPARAM(IO) • t Q . 5 )  GO  TO  560 

NASNU280 

460 

J=0 

N ASNU209 

461 

510  WRITE (6, 19) 

NASNU290 

462 

520  J  =  J  +  1 

NASNU291 

463 

KEND=  0 

NASNU292 

464 

00  530  K=1 , 9, 2 

NASNU293 

465 

L=J+LEN* (K-l) /2 

NASNU294 

466 

LINE(K) =L 

NASNU295 

4b  7 

IF(L.GT.NtW)  GO  TO  550 

NASNU296 

468 

KEND=K+1 

NASNU297 

469 

530  LINE (K+l ) =NORIG (L) 

NASNU298 

470 

550  CONTINUE 

NASNU299 

471 

IF ( KE  NU • EQ. 0) GO  TO  560 

NASNU30  0 

472 

WRITE (6 , 11 )  (LINE  (K) ,K=l,KENO) 

NASNU30 1 

473 

IF(MOO(J,LEN) . Nl • 0 ) GO  TO  520 

NASNU302 

474 

J=J+4*L£N 

NASNU3QJ 

475 

IF(J.LT.NEW)  GO  TO  51 J 

NASNU304 

4  7o 

560  CONTINUE 

NASNU30  5 

477 

C  CONVERT  I oT ART, IGNORE, IFIRST  FROM  ORIGINAL  TO  INTERNAL 

NUMBERS. 

N ASNU3J  o 

478 

I  =  I  ST  A+  I IG+  IF  IR 

NASNU307 

479 

IF(I.LE.O)  GO  To  570 

NASNU30  8 

480 

CALL  FLIP(ISTART,ISTA , INV, II 3, ICC) 

NASNU309 

481 

CALL  FL I P ( IGNOkE , I IG  , I N V , I I 3 , ICC) 

NASNU310 

482 

CALL  FLIP(IFIRST ,IFIR,INV, 113, ICC) 

NASNU31 1 

483 

IF  (  CP  ARAM  (10)  .  c.Q.5)  GO  TO  570 

NASNU312 

484 

C  PRINT  INTERNAL  NUMBERS  FOR  J-CAROS. 

NASNU313 

405 

WRITE (6, 561) 

NASNU314 

48b 

561  FORMA  T ( 30N1  i  CARDS  (INTERNAL  NUMBERS)  /) 

NASNU315 

487 

IF(ISTA.GT.O)  WRITE(6,562)  ( I S Ta RT ( I ) , I =1 , IS T A ) 

NASNU31 6 

488 

IF ( 1 1 G  • GT . 0)  WRIT E (6 , 564)  4 IGNORE (I), 1=1, II G  ) 

NASNU317 

489 

IF ( IF IR. GT . 0)  WRITE(6,566)  ( I F IRST ( I ) , I  =  1 ,  IF IR ) 

NASNU318 

490 

562  FORMA  f ( 9H  JSTART  ,20  15 / 10 0  (  9X  ,2 0  15/ ) > 

NASNU319 

491 

564  FORMAM9H  SIGNORE  ,  2 1)  I  5  /  10  0  (  9X  ,  2  0  1 5/ )  ) 

NA  SNU320 

492 

56b  F0RMAT(9H  SFIRST  , 2 J 1 5/ 10 U ( 9X , 2 0  I  5/ ) ) 

NASNU321 

493 

570  CONTINUE 

NASNU322 

494 

C  SET  UP  LIST  OF  POINTS  TO  IGNORE  IN  INT  ARRAY. 

NASNU323 

495 

K=0 

NASNU324 

49b 

IF (IPARAM(4).EQ.3)  GO  TO  920 

NASNU325 

497 

IF(NDEP.Lt.U)  GO  TO  920 

NASNU32o 

498 

C  MPC  depenoent  points  first. 

NASNU327 

499 

DO  915  I =1 , NUE P 

NASNU328 

500 

52 


J»ILD(I> 

NASNU329 

501 

IF ( J . LE • 0)  GO  TO  915 

NASNU330 

502 

K*K*1 

NASNU331 

503 

IHT  (K)*ICC(J> 

NASNU332 

504 

IF ( K , GE . MAXGRO)  CALL  FIXIT(INT,K) 

NASNU333 

505 

915  CONTINUE 

NASNU334 

506 

920  IF(IGDEG.LE.Q)  GO  TO  940 

NASNU335 

507' 

C  GRID  POINTS  WITH  DEGREE. GT . IGDEG  SECOND. 

NASNU336 

508 

IF(IGOEG.GE.MN)  GO  TO  940 

NASNU337 

509 

CALL  QEGREE(IG,II1,INV> 

NASNU338 

510 

C  HERE,  INVU)»OEGREE  OF  GRID  POINT  I 

NASNU339 

511 

DO  930  1*1, NN 

NASNU340 

512 

IF(JNV(I).LE. IGDEG)  GO  TO  930 

NASNU341 

513 

K«KM 

NASNU342 

514 

INT (K>  *1 

NASNU343 

515 

IF (K. GE . MAXGRO)  CALL  FIXIT(INT,K> 

NASNU344 

516 

930  CONTINUE 

NASNU345 

517 

940  IF(IIG.LE.O)  GO  TO  960 

NASNU346 

518 

C  SIGNORE  POINTS  THIRD. 

NASNU347 

519 

OO  950  1*1, IIG 

NASNU348 

520 

J*IGNORE (I) 

NASNU349 

521 

IF(J.LE.O)  GO  TO  950 

NASNU350 

522 

K*K+1 

NASNU351 

523 

INT  U)*J 

NASNU352 

524 

IF(K.GE.NAXGRO)  CALL  FIXIT(INT,K> 

NASNU353 

525 

950  CONTINUE 

NASNU354 

526 

C  K*NJMBER  OF  POINTS  TO  BE  IGNOREO  BEFORE  COMPRESSING 

LIST. 

NASNU355 

527 

960  IF(K.LE.O)  GO  TO  970 

NASNU356 

528 

C  DELETE  POINTS  LISTEO  IN  INT  ARRAY  FROM  CONNECTION  TABLE  IG. 

NASNU357 

529 

CALL  M0RRIS<INT,K,IG, II 1 > 

NASNU358 

530 

970  CONTINUE 

N ASNU359 

531 

C  RENUMBER  NODES  WITH  SUBROUTINE  SCHEME. 

NASNU360 

532 

IFaPARAMCIO)  .EQ.b)  IARG(5)*1 

NASNU361 

533 

118=113/2 

NASNU362 

534 

CALL  SCHEME (lARG(l) , IARG<2) , IARG(3) , IARG(4) , IARG (5) , IG, III, 

NASNU364 

535 

*  JNV(l) f JNV ( I 18+1) ,JNV(2*II8+1> , JNV(3*II6*1) ,INT 

, ICC,IlO, IP) 

NASNU365 

536 

IF(IPARAMdO)  JEQ.5)  GO  TO  580 

NASNU368 

537 

WRITE  (b , 4) IB 

NASNU370 

538 

C  WRITE  NEW  NASTRAN  OATA  DECK. 

NASMU371 

539 

58  Q  RE  A  0 ( 9 , 9 ) B 

NASNU372 

540 

WRITE (8 , 9) B 

NASNU373 

541 

IF (8( 1) • NE. BEGI) GO  TO  580 

NASNU374 

542 

590  READ ( 9, 9) B 

NASNU375 

543 

IF(B(1)  .GE.SEQG.OR.BdJ.EU.SfNDDJGO  TO  600 

NASNU376 

544 

WRITE (8,9)8 

NASNU377 

545 

GO  TO  590 

NASNU378 

546 

C  WRITE  SEQGP  CAROS. 

NASNU379 

547 

600  KREM*M0D(NEW,4) 

NASNU380 

548 

IFCNEW.GE.4)  GO  TO  605 

NASNU38 1 

549 

KBEG*  1 

NASNU382 

550 

GO  TO  612 

NASNU383 

551 

605  IENO=NtW-KREM-3 

NASNU364 

552 

OO  610  K=1,I£N0,4 

NASNU385 

553 

L=  K  ♦  3 

NASNU386 

554 

610  WRITE (8,12)  (NORIG(I) ,ILD(I),I=K,L) 

NASNU387 

555 

IF ( KREM. ECU O ) GO  TO  620 

NASNU383 

556 

KBEGS IEND+4 

NASNU389 

557 

612  OO  615  I=KBEG , NEW 

N ASNU390 

558 

615  WRITE  (8,8)  NORIG ( I) , ILO ( I) 

NASNU391 

559 

C  WRITE  THE  REMAINDER  OF  THE  NASTRAN  OECK. 

NASNU392 

560 

620  WRITE(8,9)B 

NASNU393 

5b  1 

IF (B( 1) .EQ.ENOU) GO  TO  700 

NASNU394 

5b2 

REA0(9,9)B 

NASNU395 

563 

GO  TO  620 

NASNU396 

564 

700  CONTINUE 

NASNU397 

565 

IF  (  IPARAMdO'.cU.S)  GO  TO  90  0 

NASNU398 

566 

C  PRINT  ORIGINAL  GRIO  POINT  CONNECTION  TABLE. 

NASNU399 

567 

MAXD=  MM 

NASNU400 

568 

L  =  MAX  0/ 1 1  + 1 

NASNU401 

569 

L=LEN/L 

NASNU402 

570 

705  FORMAT ( 1 0H1  GRI0,5X,5H  MAX, 15X , 13H*CONNECT IONS*, 5X , 

NASNU403 

571 

♦  23h (ORIGINAL  GRID  NUMBERS)  /5X, 

NASNU404 

572 

♦  20HPOINT  COMP  UI  ST,  OEGR  ,U(8X,1HM  ) 

NASNU405 

573 

710  FORMAT (110, 3 15, 11 19/25 (25X, 11 19/ ) ) 

NASNU406 

574 

OO  750  1*1, NN 

NASNU407 

575 

IF ( MOO ( I , L) «E3. 1)  WRITE(6,705) 

NASNU408 

576 

DO  720  J  =  l,MAXO- 

NASNU409 

5  77 

720  IP(J)=0 

NASNU41U 

578 

C  CALCULATE  MOIST  AND  PRINT  TABLE. 

NASNU411 

579 

MDI ST  =  0 

NASNU412 

580 

OO  725  J=l,MAXO 

NASNU413 

581 

K=  I G  ( I ,  J  ) 

JJ  18 

582 

IF(K.EU.O)  GO  TO  725 

NASNU415 

583 

MOIST=MAX0 (MOIST ,IABS (I-K) ) 

NASNU416 

584 

IP ( J) =NO  RIG ( K) 

NASNU417 

585 

725  CONTINUE 

NASNU41Q 

566 

K=NORIG ( I) 

NASNU419 

567 

IP1*INV ( I, 1) 

NASNU42Q 

588 

IP2=INV(MAXGRO+I,l) 

NASNU421 

589 

750  WRITE (6,710)  K , IP1 , M J I S T ,1 P2 , ( IP ( J) , J= 1 , M A XD ) 

NASNU422 

590 

C  PRINT  CONNECTION  TABLE  FOR  RENUMBERED  NUMBERS. 

NASNU423 

591 

OO  780  1*1, NEW 

NASNU424 

592 

780  ICC ( I ) =IL3 ( I ) 

NASNU425 

593 

CALL  SH I TCH ( IG, III, INT, ICC,IP(1) , IP ( MAXOEG+1 ) ) 

NASNU426 

594 

CALL  DEGREE (IG, II1,JNV{II8+1) ) 

NASNU427 

595 

L=COMPNT(IG,IIl  ,  JNVd)  ,  JNV  (1 18+1 ),  JNV  (3*  1 1  84-1)  ,  ICC) 

NASNU428 

596 

L=MAX0/26+l 

NASNU429 

597 

l  =  L  EN/L 

NASNU430 

598 

805  FORHAT (37H1LABEL  COMP  MOIST  DEGR  CONNECTIONS 

tlOX, 

NASNU431 

599 

♦  20H (RENUMBERED  NUMBERS)  ) 

NASNU432 

600 
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81  J  FORMAT  ( 5  lo »  20  I  -.>/  2  a  <  2  5X  ,  if  1 15  / )  )  NASNU4J3 

00  850  1=1, NN  NASNU434 

IF (MOJ ( I , L)  .L4. 1)  WRI  T  t  lb ,  80  5  )  NASNU435 

00  82J  J=l,MAXO  NASNU436 

820  IP(J)=0  NASNU437 

C  CALCULATE  MUlSl  AolU  PRINT  T  ABL  t .  NASNU4J8 

MUl  ST  =0  NASNU439 

DO  825  J=l, MAX J  NASNU440 

K=IG(I,J>  JJ  19 

IF(K.lQ.J>  GO  TO  825  NASNU442 

MJlST=MAXO(MJIbT,IABS(I-K)  )  NASNU443 

IP  (  J)  =  K  NASNU4*«* 

825  CONTI,  JUb  NASNU445 

C  INV<  I,  i)  =  IC(  I)  BEFORE  PACKING  NASNU4*6 

C  INV(MAXGR  J+I,l)  =IUtC<I>  3E  F  ORE  PACKING  NASnU4**7 

IP1  =  INVU,1>  NASNU448 

1P2=I.NV(MAX6RJ+I,i)  N ASNU449 

850  WRlT£(6f310)  I, 1P1 , MU  IS  T ,  IP2  »  <  IP  ( J> ,J=1 , MA  Xu  >  NASNU450 

900  RETURN  NASNU451 

END  NASNJ452 

SUOROJTnt:  FlIP(LI ST,N,'lNV,II3,ICC)  FLIP  2 

C  CONCERT  J-ARRAY  LlSf  OF  LENGTH  N  FROM  ORIGINAL  TO  INTERNAL  NUMBERS.  FLIP  3 
COMMON  /A/  MAXuRU, MAXUEG , <MOO  FlIP  4 

UIHENjIO'J  LIST  (1)  ,INV(II3,2)  ,  ICC  ( 1 )  FLIP  5 

C  CHECK  FOR  OUPLICATE  AND  ZERO  ENTRIES  AND  REDUCE  N  IF  NECESSARY.  FLIP  o 

CALL  FIXIT<L1ST,N)  FLIP  7 

IF(N.ll.a)  RETURN  FLIP  8 

00  20  1  =  1, N  FLIP  9 

J  =  L  IS  T  ( I )  FLIP  10 

IF(J.Ll.J)  GO  TO  30  FLIP  11 

LOC  =  J -  1  FLIP  12 

1U  LOC=MOD(LOG,KMOO) FLIP  13 
IF(lNV(LOC,l).cu.O)  GO  TO  30  FLIP  14 

IF  ( INVILOC, 1) .NE.U)  GO  TO  10  FLIP  15 

K= I NV  (  LOG i 2 )  FLIP  lb 

LIST ( I) =ICC (K)  FLIP  17 

20  CONTINUE  FLIP  18 

RETURN  FLIP  19 

C  ABORT  BANJIT  i)Ul  TO  ILLEGAL  GRIO  POINT  REF^RtNCE  ON  J-CONTROL  CARO.  FLIP  20 

30  WRITE  <o,4JI  J  FLIP  21 

40  FORMA  T  < 1 1H1 uRU  POINT  ,110, 30H  APPEARING  ON  A  $  CARO  IS  NOT  ,  FLIP  22 

*  25H  A  STRUCTURAL  GRIO  POINT.  /13H  FATAl  ERROR.  )  FLIP  23 

CALL  JOM3IT  (8)  FLIP  24 

ENO  FLIP  25 

SUUROJTINl  GOOv*AN(KA,KJ,NIN,  NOUT )  GOOGAN  2 

C  TH  la  ROUTINE  KlAUS  A  NASTRAN  J AT  A  DECK  ANO  RIGHT -AO JUST S  ALL  GOOGAN  3 

C  BULK  DATA  IN  ITS  FIELJS.  GOOGAN  4 

C  IN  A  00 1  T  I  ON ,  TnE  CALLlNo  ARGUMENTS  PROVIDE  THE  FOLLOWING  OPTIONS  -  GOOGAN  5 
C  K A  =  1 ,  PROCESS  ALL  CAROS  IN  THE  NASTRAN  DATA  OECK,  OR  GOOGAN  6 

C  =2,  PROCESS  ONLY  THOSE  CARDS  WITH  A  C  OR  G  IN  COLUMN  1,  GOOGAN  7 

c  mpc  Cmros,  and  Those  continuation  cards  with  all  uoogan  8 

C  NUMERIC  FIELJS,  THE  ENODATA  CARO  IS  WRITTEN  IN  ANY  CASE. GOOGAN  9 

C  KB  =  1 ,  CONVERT  ALL  8  COLUMN  FIELDS  TO  16  COLUMN  FIELDS,  OR  GOOGANIO 

c  =2,  The  field  widths  remain  unchanged.  googanii 

C  NIN  =  THE  LOGICAL  UNIT  FROM  WHICH  THE  INPUT  OECK  IS  RE  AO .  .GOOGAN12 

C  NOUT  =  THE  LOGICAL  UNIT  ON  WHICH  THE  OUTPUT  IS  WRITTEN.  G00GAN13 

C  NEITHER  NIN  NOR  NOUT  ARE  RtWOJNO  IN  THIS  ROUTINE.  GOOGAN14 

C  IF  AN  ASTERISK  APPlARS  IN  FIELD  1  AFTER  THE  MNEMONIC,  IT  IS  LEFT-  G00GAN15 

C  ADJUSTED  AGAINST  THE  MNEMONIC.  GOOGAN16 

C  THE  FOLLOWING  TWO  (2)  CAROS  ARE  REQUIRED  IN  THE  OaTA  DECK  -  G00GAN17 

C  (1)  A  BEGIN  BULK  CARD  TO  INDICATE  THE  BEGINNING  OF  THE  G00GAN18 

C  BULK  DATA  OECK,  ANO  G00GAN19 

C  (2)  AN  ENDOATA  CARO  TO  INDICATE  THE  ENO  OF  ThE  OAT  A  OECK.  G00GAN2 J 

C  ALL  CAROS  PRECtUINu  THE  BEGIN  BULK  CARD  ARE  WRITTEN  ON  NOUT  IFF  KA=1.  GOOGAN21 
DIMENSION  A  NUM (10)  G00GAN22 

COMMON  A ( 80 ) , IP ( 40 )  GOOGAN23 

COMMON  IA, ID, ICARJ,IFLAG,J,JNB,L , MKH OL J , MK INSR , MKNIN  G00GAN24 

COMMON  NJLANK,N FIELD, I , ICOL , IFIELD, I PROC , I  TV  PE  G00GAN25 

COMMON  K»KA5T,KBLK,MKI» MK J , NCOL , NIP , HN  G00GAN26 

COMMON  /A/  MAXGRD,MAXJEG»KMOO,NMPC  G00GAN27 

COMMON  73/  IPArAM(20) ,IARG(5)  GOOGAN20 

COMMON  /DO  L/  ISTART  ( li)0  )  ,  IGNORE(IOO)  ,  IF  IRST  (  100  )  GOOGAN29 

COMMON  /TOLL/  IOIM, ISTA , IIG, IF IR , IGOEG , I  SC H  GO0GAN30 

COMMON  /  Mb/  NGP.IU  GOOGAN31 

REAL  M,N|II,lL,JJ,KK  G00GAN32 

INTEGER  EOF  GOOGAN33 

C  OATA  CARDS  FOR  ALPHABET  (ALLOWS  FOR  FUTURE  AUDITIONS  TO  G00GAN34 

C  USER  OPTION  LIST).  G00GAN35 

DATA  J, C , 0, E , G , M , N , P/ 1H9 , 1HC , 1HO , 1HE , 1HG , 1 HM , 1HN , 1HP/  G00GAN36 

OATA  AA , I I , LL , 0, R/ 1HA , 1 HI, 1HL , 1H0,1 HR/  G00GAN37 

DATA  1, S,t,U,Y/lHU,lHS, 1HT,1HU,1HY/  GOOGAN38 

DATA  F,H,JJ,KK/1HF,1HH, 1HJ,1HK/  G00GAN39 

OATA  V, W,X,Z/1HV, 1HW, 1HX,1HZ/  GOOGAN40 

OATA  ASTER, PL US, BLANK, OOLLAR/1 H*,lHf,lH  ,1H$/  G00GAN41 

OATA  ANUM/1H0, 1H1, 1H2, 1HS, 1H4, 1H5 , 1 H6 , 1 H7 , 1H 0 , 1 H9/  GOOGAN42 

DATA  LFLAG/0/  G00GAN43 

DATA  IBOMB, IBOH/O , 0/  GOOGAN44 

LFLAG=LFLAG4l  GOOGAN45- 

9  FORMA  T( 1H1)  G00GAN4o 

10  FORMA  T (BDA1 )  G00GAN47 

11  FORMAT ( 8  A 1 , 4( 0X, 0A1) , 3H *XZ , 1 5/ 3H * XZ , 1 5 , 4  (  8 X  ,  8 A  1 >  ,  8 A  1 )  G00GAN4  8 

ICARD=0  G00GAN49 

MKI NS  R= 1 2  GOOGAN50 

MK  N I N  =  N I N  G00GAN51 

C  READ  EXECUTIVE  OR  CASE  CONTROL  CARD.  GOOGAN52 

20  READ(NIN,10 ) A  GOOGAN5J 

IF(EOF(NIN) . EQ»  0 ) GO  TO  21  G00GAN54 

IF ( NIN. EQ .MKNIN) CALL  BOMBIT(l)  G00GAN55 

MK h ,  Js NIN  G00GAN56 

NIN=MKIN3R  GOOGAN57 


601 

602 
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605 

60  b 

607 

608 

609 

610 
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615 
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618 

619 

620 
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622 

623 

624 
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626 

627 

628 

629 
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631 

632 

633 

634 

635 

636 

637 

638 

639 

640 

641 

642 

643 

644 

645 

646 

647 

648 

64  9 

65  0 

651 

652 

653 

654 

655 
65o 

657 

658 

659 

660 
661 
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663 

664 

665 
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668 

669 

670 
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674 
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680 
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693 
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695 
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MKlNSR*H<ROLD 
GO  TO  2i 3 

21  IFL AG  *0 
ICARJ=ICARD*1 

C  PROCESS  OUTPUT  OPTION  CARO*  IF  PRESENT. 
IF<A< l) . Nt. DOLLAR) GO  TO  2o 
IF  (  LFL  AG .  i>T  •  1 )  GO  TO  29 
C  LOOK  FOR  FIRST  KEYWORD. 

IT  YPE  *0 

IF(A( 2) . tJ.P.ANO.A (3).EJ.J)ITYPE=1 
IF (A (2) • £4. M. ANO.A (3) .EQ.P) I TYPE*4 
IF(A(2).EU.S,ANU.A<3) . CU.E) I T  yPE  =  5 
IF(A{2).E4.K.AN0.A(3) .lJ.II)  ITYPE*6 
IF(A(2).£*.N.AND.A (3)  .ED.AA)  ITYPE*8 
IF(A<2)  .cU.P.ANO.A  (3)  .t J.R) I TYPE=1Q 
IF<A(2).EQ.S.ANO.A(3) •  t  3. C ) GO  TO  1130 
IF  (A ( 2) . Eu. 3. ANJ.A (3)  .ECU T)  GO  TO  1200 
IF(A(2> .E4.U.AN0.A (3) .tQ.EI  GO  TO  1250 
IF(A(2) .EQ.F.ANO.A(J) .EQ.II)  GOTO  1300 
IF(A(2) .E4. II. AND. A(3) .EO.G)  GO  TO  1350 
IF(A(2) . tU.G.ANU.A<3) .EQ.R)  GO  TO  1380 
IF (A (2) .£U. AA.AND.AC3) .EQ.T)  ITY  PE* 1 2 
IF(A(2).E4.H.ANU.A(3)  »E J. A  A)  I  TYPE* 13 
IF(A( 2) ,NE. II. OR. A (3) .NE.NJbO  TO  1025 
C  INSERT  CAROS  FROM  ALTERNATE  FILE 
IPARAH'(11)  =  1 
HKMOL  J=NIN 
NlNsHKINSR 
HKlNSR=MKNOLl 
00  1021  MKI=2,80 
MKJ*81-H<I 
1021  A (MKJ*1) *A <  MKJ) 

IPARA  H ( b ) =4 

1025  IFdTYPE.EU.  Q)G0  TO  26 

c  look  for  second  keyword. 

1*3 

22  i=i*i 

IF ( I.GE. 79) GO  To  2b 
IF  (A(  1)  .Nc.BlANOGO  TO  22 
24  1*1*1 

IF( I.GE. 8J) GO  TO  26 
IF(A(  I)  .  EJ.JLANOGO  TO  24 
J=0 

IF(A(I) .E4.S.AN0.A(I*1) .Ea.E)J=l 
IF(A(  I)  .E<4«AA.ANO.A(I*l)  .£Q.LL)J*2 
IF(A(I).£a.N. AND. A (1*1) .EJ.O) J*3 
IF  <  A ( 1 1 .Ei.Y.ANJ.A(I*l) • E J • t ) J=4 
IF(A( I) .EO.rt.ANO.A(I*l) .EO.II)  J=5 
IF(A(I> .Ea.M.AND.A(I*i) .EO.AA)  J=6 
IF(J.Ea.O)GO  To  2b 
C  SET  PARAMETER. 

IPARA i(ITYPE)=J 
GO  TO  26 

C  READ  {SCHEME  CARD. 

1100  CALL  REAJIT (A,IP,NIP) 

ISCH=1 

I=MlN0<NIP, 5) 

IF(I.EQ.O)  GO  TO  29 
00  1110  J*  1  ,  I 
1110  IARG( J)=IP(J) 

GO  TO  29 

C  READ  {START  CARO. 

1200  CALL  REAJlT (A, IP,NIP) 

1  =  1ST  A 

1ST  As  IS! A*N IP 

IFUSTA.Ll.IDIM)  GO  To  1205 
I0OM=  2 
ISTA=  IOI M 
GO  TO  29 

1205  00  1210  J=1 , NIP 
1210  ISTART ( I  * J) = IP ( J) 

GO  TO  29 

C  REAO  {DEGREE  CARO. 

1250  CALL  REAJIT (A, IP, NIP) 

IGDEG=IP (1) 

GO  TO  29 

C  READ  {FIRST  CARJ. 

1300  CALL  REA  JIT (A , IP , NIP) 

1= I  FI R 

IFIR* IFI R*NIP 

IFdFIR.LE.  IJIM)  GO  TO  1308 
IBOH*  2 

IFIR* IOI M 
GO  TO  29 

1308  00  1310  J=1 , NIP 
1310  IFIRSTTI+J) =IP(J) 

GO  TO  29 

C  REAO  SIGNORE  CARD. 

1350  CALL  READIT (A, IP, NIP) 

I*  I IG 

IIG=I IG+NIP 

IF ( IIG.Lc. IOIM)  GO  TO  1360 
I80M=2 
IIG=I OIM 
GO  TO  29 

1360  00  1365  J* 1 , NI P 
1365  IGNORE(I*J)*IP(J) 

GO  TO  29 

C  REAO  {GRID  CARD. 

1380  CALL  REA0IT(A,IP,NIP) 


GOUGAN58 
G00GAN59 
bOOGANoO 
GOOGANol 
GOOGANb2 
G00GAN63 
G00GAN64 
G00GAN65 
GOOG ANob 
G00GAN67 
GOOGANod 
G00GAN69 
GOOGAN70 
G00GAN7 1 
GOOGAN72 
G00GAN73 
G00GAN74 
G00GAN75 
G00GAN76 
G00GAN77 
GOCJGAN78 
GOOGAN79 
GOOGANtti) 
G00GAN61 
GOOGAN82 
GOOGAN83 

GOOG ANd  4 
G00GAN85 
GOOGAN80 
GOOGAN87 
G00GAN8  8 
G00GAN69 
GOOGAN9J 
G00GAN91 
G00GAN92 
GUOGAN93 
G00GAN9** 
G00GAN95 
G00GAN96 
GOOGAN97 
bOJGAN98 
GOOGAN99 
GOOGAIOO 
GOOGAlOl 
GOOGA10  2 
GUOG A  10  3 
GOOGAIO  4 
GOOGA105 
G00GA1U6 
GOOGA1J7 
GOOGAIOO 
GOOGA109 
GOOGA11Q 
GOOGA11 1 
GOOG A1 12 
GOOG A 11 3 
GOOGAll* 
GOOG A 11 5 
GOOGAllo 
GOOGA11 7 
G00GA118 
GOOG A 1 1 9 
GOOG A 12  0 
GOOGA 12 1 
GOOGA122 
GOOGA 123 
GOOGA 124 
G00GA125 
GOOGA126 
GOOGA12  7 
GOOGA 128 
GOOG  A 12 9 
GOOGA 13  0 
GOOGA 131 
G00GA132 
GOOGA133 
GOOGA 1 34 
G00GA135 
G00GA136 
GOOGA137 
GOOGA 138 
GOOG A 139 
GOOGA 140 
G00GA141 
GOOG A 142 
GO0GA143 
GOOG A1 44 
GU0GA145 
G00GA146 
G00GA147 
6  00GA143 
GOOGA149 
G00GA15Q 
G00GA151 
G00GA152 
G00GA153 
GOOGA154 
GOOGA155 
G00GA156 
G00GA157 


701 

702 

703 
7  U  4 

705 

706 

707 

708 
7U9 

710 

711 

712 

713 
71* 
715 
71b 

717 

718 

719 

720 

721 

722 

723 

724 

725 

726 

727 

728 

729 

730 

731 

732 

733 
73* 

735 

736 

737 

738 

739 

740 

741 

742 

743 

744 
7  45 

746 

747 

748 

749 

750 

751 

752 

753 

754 

755 
75b 

757 

758 

759 

760 

761 

762 

763 

764 

765 
76b 

767 

768 

769 

770 

771 

772 

773 

774 

775 

776 

777 

778 

779 

780 

781 

782 

783 

784 

785 

786 

787 

788 

789 

790 

791 

792 

793 

794 

795 
79b 
79  7 

798 

799 

800 


NGRIO=IP (1) 

G00GA158 

001 

•GO  TO  29 

G00GA159 

802 

C  LOOK  FOR  BEGIN  BULK  CARO. 

G00GA160 

803 

2b  1  =  0 

GOOGA161 

804 

2?  1=1+1 

G00GA162 

805 

IFU.GT.  75)  GO  TO  29 

GOOGA lb  3 

806 

IF  C  A  < I) .£1. BLANK) GO  TO  27 

G00GA164 

807 

IF ( A ( I) •  Nt  *  B)  Gu  TO  29 

GOOGA165 

808 

IF<AU  +  l)  .Nt.EJGO  TO  29 

GOOGA 166 

809 

IF  C  A ( 1  +  2) «NE.G)GO  To  29 

GOOGA 1 6  7 

810 

IF(A(I+3)  .NE.IDGO  TO  29 

GOOGA 16  8 

811 

IFLAG=1 

GOOGA 169 

812 

C  LEFT-ADJUST  BEGIN  BULK  CARO. 

G00GA170 

613 

K=  7  3-  I 

GOOGA 171 

814 

DO  28  J= 1  *  72 

GOOGA 172 

815 

IF<J.LE.K)A*J)=A*J+I-1> 

GOOGA 1 7  3 

616 

28  IF(J.GT.K) A (J)= BLANK 

GOOGA 1 7  4 

617 

IF(LFLAG.GT.l)  GO  TO  29 

GOOGA 1 7  5 

618 

C  REJECT  ILLEGAL  PARAMETERS  AMO  SET  TO  DEFAULTS. 

GOOGA 176 

619 

IF * IPARAM(l) .NE«2.ANO.IPARAM(l) .NE.3)  I PAR Ah (1) *1 

GOOGA 177 

620 

00  1450  1=2,9 

GOOGA 1 7  8 

821 

1450  IF<  IPARAMU)  .NE.4)  IPARAM<I)*3 

GOOGA179 

822 

IF ( IPARAM(lfl) .NE.b)  I PARAM ( 1 0 ) =5 

GOOGA 18  0 

823 

IF*IPAKAM<12) .NE.3)  IPARAM*12)=4 

GOOGA 18 1 

824 

IF(  IPARAHU3)  .Nc.4)  I PARAM  (13)  =3 

G00GA182 

825 

CALL  GRIJ(NGRID) 

GOOGA 18  3 

62b 

1= 1ST  A* I IG+ IFIR+ ISCM+ IG  DEG 

GOOGA 1 84 

827 

IF(I.Ll.O)  GO  TO  29 

wOO  G  A  1 8  5 

828 

C  CHECK  FOR  iLLcu Al  SCHEME  ARGUMENTS. 

GOOGA 186 

829 

00  14  ol  1  =  1,3 

GOOGA 18  7 

830 

1460  IF(IARG(I).LT.1,0R.IARo(I)  .GT.MAXGRD)  IB0.1B=1 

GOOGA 1 8  8 

831 

IF (  IA  RG ( 4> .LT.2.0R.IARG(4)  . GT . 3)  I80MB=1 

G  OOG  A  189 

832 

IF  <  I A  RG  *  5  > .LT.O.OR. IARu (5) .GT.l)  IUOMd=l 

GOOGA 190 

833 

WRITE  (b,  )) 

s>00GA191 

834 

IF  < IS  CH. GT . 0)  WRITE(6,1500)  ( I ARG ( I ) , I  =  1 , 5 ) 

GOOGA 1 92 

835 

1500  FORMAT*//,  9H  iSCHEME'  ,  1 0 1 10/ 20 0 ( 9X ,  1 0  11 0 / )  ) 

GOOGA 1 93 

836 

IF(ISTA.GT.O)  WRlTc*6,1505)  < I START  *  I ) , 1  =  1 , 1 STA ) 

GOOGA 194 

837 

1505  FORMAT*//, 9H  fb T ART  ,  1 0 I 1 0/ 20 0 ( 9X ,  1 0 1 i 0/ ) ) 

GOOGA 1 9  5 

63d 

IF ( IGJto.uT  ,0)  NRITEC5, 1510)  IGOEG 

GOOGA 1 9b 

639 

1510  FORMAT*//, 9ri  iOtGREE  ,  1 0 1 10/ 20 0  * 9X ,  1 0 1 1 0/ ) ) 

GOOGA 19  7 

840 

IF* IFIR.GT. 0)  WRITEtb, 1515)  ( I  FI RST ( I ) , I  =  1 , 1  FIR ) 

bOOG A  198 

841 

1515  FORMA  T ( // , 9ri  1FIRST  , 1 31 10/20 0 C 9X , 1  011  0/)  ) 

GOOGA199 

842 

IF(IIG.GT.O)  MRITE(6, 192U)  ( IGNORE  *  I ), I = 1 , 1 1 G) 

GOOGA  2  U  0 

843 

1520  FORMAT*//, 9H  SIGNORE  ,  1  0  110/200  (  9X  ,  10  11  0 />) 

bOOG A  2  0 1 

844 

IF* IBOMH.EQ.l)  CALL  80M3IT*4) 

GOOGA  20  2 

845 

IF ( IBOM • ED . 2 )  CALL  B0M6IT*9) 

GOOGA203 

846 

29  IF(KA.fcD.l) WRIT£(NOUT,10) A 

G00GA2U4 

847 

IF* IFLAG.ta. J)GO  TO  20 

GOOGA205 

84  d 

C  RETURN  IF  RIGHT-ADJUSTING  OF  CARDS  IS  NOT  NEEDED . 

G  00  GA  20  6 

849 

IF* IP  ARAM* 5) .ED. 3. AND. I PARAM *6) .£Q. 3) RETURN 

bOOG  A 2  J  7 

860 

C  READ  BULK  DATA  CARO. 

GOOGA  2  0  8 

861 

30  READ ( Nl N , 1 0 ) A 

GOOGA  2  0  9 

652 

IF  <  EOF  C  NI N  >  .ED.QJGO  TO  31 

bOOGA21 J 

85d 

IF(NIN.EI.NKNIN)  CALL  J0M9IT*1) 

GOOGA211 

864 

C  SWITCH  INPUT  FILES 

GOOGA  212 

655 

MKHOL  0  =  N I N 

G00GA21 3 

85o 

NI N=M<I N3R 

GOOG  A  2 1 4 

857 

MK I  NS  R=  M  KHOLO 

GOOGA  2 1 5 

858 

GO  TO  30 

U00GA216 

859 

31  IC  A  Rb  =  I C  ARlJ  ♦  1 

GOOGA217 

86  U 

C  LEFT-ADJUST  FIRST  FUlO. 

GOOGA  2 1 8 

861 

DO  16J0  1=1,8 

G  OOG A  2 1 9 

862 

IF*A(  I) ,Nc. BLANK)  GO  TO  1610 

GOOGA220 

863 

1600  CONTINUE 

G0DGA221 

864 

GO  TO  JO 

G0UGA222 

865 

1610  IF(I.£4.1)  oO  TO  1 b50 

GOOGA223 

86b 

J=I-1 

G0UGA224 

867 

K=  8  -  J 

GOOGA22  b 

8b8 

DO  lb  2  0  1  =  1, K 

GOOGA  22  6 

8b9 

A(I)=A(I+J) 

G00GA227 

8  7  U 

1620  A(I+J)=dLAN< 

GOOGA228 

871 

lo5 1)  CONTI  NUL 

GOOGA  22  9 

872 

C  LOOK  FOR  5EQGP  CARO. 

GOO  G A  2  3  0 

673 

IF(A(l).£4.S.ANU.A(2).tJ.E.AND.A<3).Lu.U.AND.A(4).cJ. 

,G> IP ARAM (7) = 4600 G A 231 

8/4 

C  LOOK  FOR  COM Me  NT  CARO. 

GOOGA232 

875 

IF  t  A  (  1)  .  tO.  JOLL  AR.  ANO.K  A.EQ.  1)  GO  TO  35 

GOOGA233 

87b 

C  LOOK  FO<  ENOJATA  GARJ. 

GOOGA 2 3  4 

877 

1  =  0 

GOOGA  23  5 

878 

32  1=1+1 

GOOGA  2  3  6 

879 

IF ( I . GT. 75) GO  TO  35 

GOOGA  23  7 

3d  J 

IF  *A( I) .LJ.BlANK)GO  TJ  32 

o  OOG  A2  3  8 

881 

IF ( A  *  I ) . N£ • l ) bO  TO  40 

GOOGA  2  3  9 

882 

IF  t At  1*1)  .NE.N) GO  TO  40 

GOOGA243 

883 

IF(A<  1+2) . NE. J) GO  TO  43 

G00GA241 

884 

IF ( A ( 1  +  3) .NE. J>  GO  TO  40 

GOOGA  2  42 

885 

C  LEFT -AO JU  ->T  ENDOATA  CARO. 

GOO  G A  24  3 

6O0 

K=  73-  I 

bOOG A  244 

887 

DO  33  J=l, 72 

GOOGA  2  4  5 

888 

IF* J.  Lt . K) A  < J) =A ( J  +  I-l) 

G00GA246 

889 

33  IF  * J. GT. K) A  * J) =6lANK 

GOOGA  2  4  7 

890 

WRITL  *  NO JT , 10) A 

G00GA248 

891 

RETURN 

GOOGA  249 

892 

35  WRITE  *NOJT, 10) A 

bOOG  A  2  50 

693 

GO  TO  oO 

GOOGA251 

894 

C  DETERMINE  IF  CARO  IS  TO  Be  PPJCESSLO. 

GODGA252 

895 

40  IFCKA.tu.l) GO  TO  150 

oOOG A253 

89b 

IF  (A*  1)  .EJ.C.OK.A*l).G>4.G)GO  TO  160 

GOOGA254 

897 

IF (A(l) .cj.M.ANO.A (2) ,cJ.P)GO  TO  150 

G00GA255 

898 

NC  0  L  =  3 

GOOGA25o 

899 

IF (A(l) .l^.ASTERJGU  TO  50 

GOOGA25  7 

9  U  0 

58 


IF(A(1)  ,EQ.PLU5)60  TO  60 

GOOGA258 

901 

60  TO  30 

G00GA259 

902 

50  NCOL* lb 

G0OGA260 

90  3 

60  NFIEL0*6-»/NC0l 

G00GA261 

904 

1*0 

G00GA262 

905 

to  i«m 

G000A263 

906 

IFU.GT.NFIELUJuO  TO  150 

G00GA264 

907 

IPROC  *0 

G00GA2o5 

90d 

iflag*o 

G00GA2bo 

909 

J*0 

G00GA2o7 

910 

80  J*J+i 

G00GA268 

911 

IF < IPROC .£0.1)00  TO  70 

G00GA269 

912 

IF(  J.LE.NCODGO  TO  90 

GOOGA270 

913 

IFCIFLAG.EQ.DG0  TO  30 

GOOGA27 1 

914 

GO  TO  70 

G00GA272 

915 

90  ICOL=8*NCOl*(I-1)*J 

UOOGA27J 

91b 

IF (AC ICOL) • £3* BLANK) SO  TO  80 

G00GA274 

917 

IFLAG«1 

GOOGA27? 

918 

DO  100  L*i » 10 

GOOGA276 

919 

100  IF (AC ICOL) . tU. ANUM(L) ) IPR0C*1 

GOOGA277 

92  0 

GO  TO  80 

GOOGA278 

921 

c 

PROCESS  FIRST  FIELO. 

GOOGA279 

922 

150  NCOL* 8 

GOOGA280 

923 

KAST=  8 

G00GA281 

924 

K8L  K=  8 

O00GA282 

925 

00  160  1*1,8 

GOOGA  2  d  3 

926 

IF  (  A  (  I )  .NL.BLAN<.ANO.A(I).NE.ASTER.AND.A(I*1>.EJ.BLANiO  <3LK*I*1 

G00GA284 

92  7 

IF(A(I)  .EJ.ASTtRKAST*! 

GOO  GA  2  8  5 

928 

163  IF (A ( I) . EC. ASTER) NC0L=lo 

G00GA286 

929 

IF (A( 1) • £4.  PLUS) NGOL* 8 

G00GA28  7 

930 

IF(NC0L.E4.1o)G0  TO  170 

G00GA288 

931 

IF { KB . tO. 2) GO  TO  200 

G00GA289 

932 

IF  (  A(  1)  .  NE.PlJS)  A(K8LO  *  ASTER 

GOOGA290 

933 

IF<A< 1) . tu.PLUS) A(1)=A5TER 

G00GA291 

934 

GO  TO  200 

G00GA292 

935 

170  IF ( A ( 1) .EG. ASTEK)60  To  200 

G00uA293 

936 

IA  =  MI  MO  (  KAST ,XtiLK) 

GOOGA294 

937 

IO*MAXO (<AST,<oL<) 

G03GA295 

938 

A (  I  U) *BLANK 

G00GA29o 

939 

A ( I A ) *AST£* 

GOOGA29/ 

940 

c 

RIGHT-AOJUST  ALL  BULK  DATA  WHICH  IS  TO  3t  PROCESSED. 

G00G4293 

941 

200  NFIEL0sO4/NC0L 

G00GA299 

942 

IFIEL  J=Q 

G00GA3Q  0 

943 

210  IFIELD=IFIcLJ*l 

GUOGA30 1 

944 

IF(IFILLl).GI.NFIELO)GO  To  300 

GOOGA3J2 

945 

1*0 

GOOGA  33  3 

94  6 

220  1=1*1 

GOOGA304 

947 

IF  ( I  •  ST  •  Nl»OL  >  GO  TO  210 

GOOGA3J5 

9**8 

ICUL=9*NCCL*IFIEL0-I 

GOOGA306 

949 

IF ( A ( ICOL) • EQ. BLANK) GO  TO  220 

GOOGA3J7 

95  0 

NBL  AN<= I -1 

GOOGA  3d  8 

9»1 

NN=NC OL-N3LANK 

G00GA3Q  9 

952 

00  230  I=i,NCOL 

GOOGA310 

953 

J=9*NC0LMFIELD-I 

G00GA31 1 

954 

jnb=j-nblank 

oOOG A31 2 

955 

IF ( I .  lE  .  (N) A( J) *A< JNB) 

GOOGA  31 3 

956 

IFd.GT.NN)  A<J)=3LANK 

uOQGAJl h 

957 

230  CONTINUE 

GOOGA315 

95d 

GO  TU  210 

G00G4316 

959 

c 

WRITE  NEW  CARJ. 

GOOGA31 7 

9bd 

303  IF(KB.EJ.l)  A(73)  =  AST cR 

GOOGA018 

961 

IF(NC0L.E4.8.AND.<B.£4.i)S0  TO  310 

G00GA319 

962 

write (NOJT , 1 J 1  A 

G00GA32J 

963 

GO  TO  oO 

G00GA32 1 

964 

310  WRITE  (NOJT,  11)  ( A ( I ) » 1=1 , 40 )  ,  ICARD*  ICAKJ  ,  (A  ( I ) ,  1  =  41, 8u> 

G00GA322 

965 

GO  TO  30 

G00GA323 

9bo 

ENO 

G00GA32  4 

967 

SUBROUTI  bRIJ(NGRlO) 

GRID  2 

96  a 

c 

PARTITION  tXPANJABLE  CORE. 

GRID  3 

969 

COMMON  / 31 T 3/  N 31 T IN, MB I TEX 

GRID  4 

9  7  d 

COMMON  /A/  MAXGRJ, MAXOuG 

GRID  5 

971 

COMMON  /</  11(7) , KOR 

GRID  o 

972 

MAX  =  l6o8<* 

GRID  7 

973 

N=NGR 10 

GRID  8 

974 

NdITiN  =  oU 

JJ  2d 

975 

IF(N.LT.IOO)  N=ldd 

GRID  11 

976 

IF ( N. GT • MAX )  GO  TO  40 

GRID  12 

9/7 

c 

CALCULATE  HIJTH  11(2)  OF  16. MATRIX. 

GRID  13 

978 

20 

L=b0/NBI TIN 

GRID  14 

979 

M=60/Nl-I  TjX 

GRIO  15 

980 

N=N*L*M-1 

GRID  16 

981 

N=  N-M  00  (  N,  L  *M) 

GRID  17 

982 

MAXGRO=N 

GRID  18 

983 

c 

I=PA0KE3  LENGTH  FOR  INTERNAL  NUMBER. 

GRID  19 

984 

c 

J=PACK£0  LENbTrt  FOR  ORIGINAL  NUMBER. 

GRIO  2d 

985 

I=N/L 

GRIU  21 

985 

J  =  N/M 

GRIO  22 

9  87 

c 

SET  UP  01  litNSIONS  IN  II  A  AY ,  WHERE  IG  (  III,  112)  ,IN V  (II  3,2)  , 

GRIO  23 

988 

c 

INTCII4) , ICC (1 15) ,IlJ(II6) ,  NORIG  (I I 7) 

GRIU  2** 

9o9 

II(1)=1 

GkID  25 

990 

11(3) =  2*J 

GRID  2b 

991 

II (4) =J 

GRID  27 

992 

II (5) -J 

GRIO  2d 

993 

11(6) =J 

GRIO  29 

994 

11(7) =j 

GRID  30 

993 

1=2*11  ( 3)  *11  (*♦)  *11(5)  *11(6)  *11(7) 

GRID  31 

996 

11(2) = (K3R* I) / ( II (l)+2) 

GRID  32 

997 

c 

DENOMINATOR  CONiAINS  A  2  TO  ALt-OH  FOR  2  bUXAlCH  AkRAYS,  EACH  OF 

GRID  a* 

99  8 

c 

LENGTH  MAXJE^. 

GRIO  3h 

999 

II  (2)  SPI.«(II  (2)  ,N-1) 

GRIO  35 

iOuQ 

57 


HAXDE3= 11(21 

GRID  36 

1001 

RETURN 

GRIO  37 

1002 

c  substitute  max  if  ngkid  too  large. 

GRID  38 

1003 

40  N=MAX 

GRID  39 

1004 

WRITE  (b i 50)  NGKID, N 

GRID  40 

1005 

50  FORMAT (2JH16ANOIT  HARMING  MESS AGE/1 0 X , 6HSGRI  0  ,I10.5X, 

GRID  41 

1006 

f  9HTOO  LARGE  /10X,6H1GRID  , 110  ,  5X  , 12H SUBSTITUTED.  ) 

GRIO  42 

1007 

GO  TO  20 

GRID  43 

1008 

END 

GRID  44 

1009 

SUBROUTINE  REAOIT < A, IP, NIP) 

READIT  2 

1U10 

C  THIS  ROUTINE  READS  AND  STORES  (IN  IP)  NUMERIC  OATA  APPEARING 

ON 

REAOIt  3 

1011 

C  J-CONTROL  CAROS  UP  TO  COLUMN  72. 

READIT  4 

1012 

DIMENSION  ANUM(IO) 

READIT  5 

1013 

DIMENSION  A ( 1 ) , I P ( 1 ) 

READIT  6 

1014 

DATA  ANUM/1H0,1H1, 1H2, 1HJ, 1H4, lH5,lHb,lH7, 1H8, 1H9/ 

READIT  7 

1015 

C  INITIALIZE  ARRAY. 

READIT  8 

1016 

NIP  =  0 

REAOIT  9 

1017 

DO  10  1=1,40 

READIT1U 

1018 

10  IP<I)=0 

READIT11 

1019 

1=3 

REAOIT 12 

1020 

DO  70  KOUNT  =  1,40 

READIT 13 

1021 

NUM  =  0 

REA0IT14 

1022 

NUMFL  =0 

REAOIT15 

1023 

20  1=1*1 

READIT16 

1024 

IF ( I  *  LE • 721  GO  TO  30 

REAOIT17 

1025 

IF  (  NUMFL  .tQ.  1)  GO  TO  t>0 

REAOITIS 

1026 

RETURN 

READIT19 

1027 

30  K=99 

READIT20 

1028 

DO  40  J=l,10 

REAOIT21 

1029 

40  IF ( A{ I) , EQ. ANUM( J) )  K=J-1 

READ  I T22 

1030 

IF ( K . Nt . 99)  GO  TO  50 

READIT23 

1031 

IF (NUMFL )  60,20,60 

READIT24 

1032 

50  NUMFL  =  1 

REAOIT25 

1033 

NUM  =  1  Q*  N  JM  ♦  K 

READIT26 

1034 

GO  To  ?0 

READIT27 

1035 

60  NlP=KOUNT 

READIT28 

1036 

IP  (  NI  P)  =  NUM 

READIT29 

1037 

70  CONTINUE 

READIT30 

1038 

NIP  =  4  0 

READ  IT3 1 

1039 

return 

REAUIT32 

1040 

END 

READIT33 

1041 

SUBROUTINE  BOMB  IT ( IERR) 

BOMBIT  2 

1042 

C  BOMB  BANDIT  TO  SUPPRESS  THE  EXECUTION  OF  NASTRAN. 

BOMBIT  3 

1043 

COMMON  / 3/  IPARAM(20) 

BOMBIT  4 

1044 

COMMON  /K/  11(7) , KORE , I FL 

BOMBIT  5 

1045 

3  FORMAT (4 iHllNSUFFICItNT  CORE  OR  $GRIO  N  CARD  REQUIRED) 

JJ  21 

104o 

5  FORMAT (20U(lrtx,130X/)  ) 

BOMB  I T 15 

1047 

B0MBIT16 

1048 

GO  TO  (10,24,30,40,50,60,70,80,90) ,  IERR 

BOMB  I T1 7 

1049 

C  EOF  ENCOUnTEREO. 

0OMBIT18 

1050 

10  WRITE (6, 12) 

B0MBIT19 

1051 

12  FORMAT (55H1BANUIT  FATAL  ERROR  -  MISSING  8EGIN  BULK  OR 

ENDDATA 

,BOMBIT20 

1052 

f  6H  CARD.  ) 

BOMBIT21 

1053 

CALL  REMARK ( 3 9H  "MISSING  BEGIN  BULK  OR  ENDDATA  CARD  ) 

BOMBIT  22 

1054 

GO  TO  500 

BOMBIT23 

1055 

C  BULK  DATA  CARU  OUT  OF  SORT. 

B0MBIT24 

1056 

20  CALL  REMARK (31H  •♦BULK  OATA  CARD  OUT  OF  SORT  ) 

B0MBIT25 

1057 

GO  TO  500 

BOMBIT  2  6 

1058 

C  SEQGP  CAROS  IN  BECK  AND  RESEQUENCING  REQUESTED. 

BOMB I T2  7 

1059 

30  CALL  REMARK (32H  "SEQGP  CAROS  ALREADY  IN  DECK  ) 

B0MBIT28 

1060 

GO  TO  500 

B0MBIT29 

1061 

C  1SCMEME  ILLEGAL  ARGUMENTS. 

BOMB I T30 

1062 

40  WRITE (6,42) 

80MBI T31 

1063 

42  FORMAT (46H1BANDIT  FATAL  ERROR  -  ILLEGAL  ARGUMENTS  ON, 

BOMBIT32 

1064 

♦  14H  ISCHEME  CARO.  ) 

B0MBIT33 

1065 

CALL  REMARK  ( 30H  "ILLEGAL  JSCHEME  ARGUMENTS  ) 

B0MBIT34 

1066 

GO  TO  500 

BOMBIT35 

1067 

C  TOO  MANY  TERMS  IN  MPC  EQUATION. 

B0MBIT36 

1068 

50  CALL  REMARK ( 36H  "MPC  EQUATION  HAS  TOO  MANY  TERMS  ) 

80MBIT37 

1069 

GO  IO  500 

BOMBIT38 

1070 

C  MAXOEG  EXCEEOdO. 

B0MBIT39 

1071 

60  CALL  REM ARK ( 28H  "MAXIMUM  DEGREE  EXCEEOED  ) 

BOMBIT40 

1072 

WRITE (6,3) 

JU  22 

1073 

GO  TO  500 

B0MBIT42 

1074 

C  MAXGRO  EXCEEDED. 

BOMBIT43 

1075 

70  CALL  REMARK ( 39H  "MAX  NUMBER  OF  GRID  POINTS  EXCEEOED  ) 

B0M8IT44 

1076 

WRITE (6,3) 

JJ  23 

1077 

GO  TO  500 

B0MBIT46 

1078 

C  NON-EXISTENT  GRID  POINT  REFERENCE  ON  J-CARO 

0OMBIT47 

1079 

80  CALL  REM  ARK  ( 32  H  "I LLEGAL  REFERENCE  ON  J-CARD  ) 

B0MBIT48 

1080 

GO  TO  500 

B0MBIT49. 

1081 

C  TOO  MANY  GRID  POINTS  ON  I-CARD. 

B0MBIT5  0 

1082 

90  WRITE (6, 92) 

B0MBIT51 

1083 

92  FORMAT (51H1BANOIT  FATAL  ERROR  -  TOO  MANY  POINTS  ON  S-CARD) 

BOM  B I T 5 2 

1084 

CALL  REMARK  (30H  "TOO  MANY  POINTS  ON  S-CARO  ) 

80MBIT53 

1085 

GO  TO  500 

B0HBIT54 

1086 

C  ABORT  BANDIT. 

B0MBIT55 

1087 

500  CALL  REMARK  ( 1 7H  "BANDIT  ABORT  ) 

B0MBIT56 

1088 

CALL  REMARK  <  23H  "NASTRAN  SUPPRESSED  > 

BOHBIT57 

1089 

B0MBIT58 

1090 

WRITE  (6,5) 

B0MBIT59 

1091 

STOP 

B0M8ITB6 

1092 

END 

BOMBIT67 

1093 

SUBROUTINE  SC AT ( KG , NC ON , NE W , IN V, I 13 , NORIG ) 

SCAT  2 

1094 

C  THIS  ROUTINE  USES  SCATTER  SORT  TECHNIQUES  FOR  EACH  GRID  POINT 

SCAT  3 

1095 

C  ENCOUNTERED  TO  DETERMINE  WHETHER  OR  NOT  THE  POINT  HAS 

SCAT  4 

1096 

C  SEEN  SEEN  BEFORE.  IF  NOT,  INV,  NORIG,  ANO  NEH  ARE  UPOATEO. 

SCAT  5 

1097 

C  INV ( I , 1 >  CONTAINS  AN  ORIGINAL  GRID  POINT  NUMBER 

SCAT  6 

1098 

C  IN V ( I  *  2)  CONTAINS  THE  INTERNAL  NUMBER  ASSIGNED  TO  IT  (BEFORE  SORTING) 

SCAT  7 

1099 

DIMENSION  INV(II3,2), NORIG(l) 

SCAT  8 

1100 

58 


COMMON  /A/  MAXGRO, MAXJEG, KMOD 

SCAT  9 

1101 

DIMENSION  KG( 1 ) 

SCAT  10 

1102 

OO  100  I*l,NCON 

SCAT  11 

1103 

NOL  D=  KG ( I ) 

SCAT  12 

1104 

IF ( NOLO. EJ. 0  >  GO  TO  100 

SCAT  li 

1105 

LOC=NOLD-l 

SCAT  14 

1106 

10  LOC*MOD(LOC,KMOO)+1 

SCAT  15 

1107 

20  IF  (INV(LOC,l) . NE . Q )  GO  TO  30 

SCAT  16 

1108 

INV  (L  OC ,  1)  =  NOLD 

SCAT  17 

1109 

NEH=NEW+1 

SCAT  16 

1110 

IF(NEW.GT. MAXGRO)  GO  TO  150 

SCAT  19 

1111 

NORIG (NEW) =  NOLO 

SCAT  20 

1112 

INV (LOC , 2) =NEH 

SCAT  21 

1113 

GO  TO  40 

SCAT  22 

1114 

30  IF(INV(LOC,l) .NE.NOLD)  GOTO  10 

SCAT  23 

1115 

40  KG (I) =INV(L0C*2) 

SCAT  24 

1116 

100  CONTINUE 

SCAT  25 

1117 

RETURN 

SCAT  26 

1118 

150  WRITE (6* 160)  MAXGRO 

SCAT  27 

1119 

160  FORMA  T ( 35H1  THIS  STRUCTURE  CONTAINS  MORE  THAN, 

16. 

SCAT  20 

1120 

♦  14H  6 RIO  POINTS.  / 14H  FATAL  ERROR. 

) 

SCAT  29 

1121 

CALL  U0M3IT(7) 

SCAT  30 

1122 

END 

SCAT  31 

1123 

SUBROUTINE  BRIGIT ( IG, III, INV , I 13 , INT , ICC , NORIG 

.IP) 

BRIGIT  2 

1124 

C 

THIS  ROUTINE  GENERATES  A  NEW  INTERNAL/EXTERNAL  CORRESPONDENCE 

BRIGIT  3 

1125 

c 

TABLE  NORIG  ANO  CONNECTION  TABLE  IG  SUCH  THAT 

the  new  internal 

BRIGIT  4 

1126 

c 

NUMBERS  CORRESPOND  TO  A  SORT  OF  THE  ORIGINAL 

NUMBERS  INTO 

BRIGIT  5 

1127 

c 

ASCENDING  OKOtR. 

BRIGIT  6 

1126 

c 

INPUT  -  IG, INV, NORIG 

BRIGIT  7 

1129 

c 

OUTPUT  -  IG, NORIG, ICC 

BRIGIT  6 

1130 

c 

SCRATCH  -  INT, IP 

BRIGIT  9 

1131 

OIMENSION  IG< 111,1) , INV(II3,2) 

BRIGIT1 0 

1132 

DIMENSION  INT (1) ,ICC<1) , NORIG (1) , IP(1) 

BRIGIT 1 1 

1133 

COMMON  /S/  NN,MM, IH, I J 

BRIGIT12 

1134 

COMMON  /A/  MAXGRO, MAX OE G , KMOO , NMPC 

BRIGIT 13 

1135 

COMMON  / 3ITS/  NBITIN, NUITEX, IPASS 

BRIGIT14 

1136 

REWIND  6 

BRIGIT15 

1137 

c 

PERFORM  A  ROUGH  SORT  OF  THE  ORIGINAL  GRIO 

NUMBERS. 

BRIGIT 16 

1136 

L  =  0 

BRIGIT17 

1139 

KF  AC= - 1 

BRIGlUfi 

1140 

20  KFAC=KFAC+1 

BRIGIT 19 

1141 

NIN=2147483647 

BRIGIT20 

1142 

00  50  1  =  1 , KMOD 

BRIGIT21 

1143 

IF (INV (I, 11 • GT . ( KF AC*KHOD)  ) 

8RIGIT22 

1144 

♦  M I N=  M INO (MIN, INV (1,1)) 

BRIGIT23 

1145 

50  CONTINUE 

BRIGIT24 

1146 

KF  AC=  (MIN-1) /KMOO 

BRIGIT25 

1147 

00  QO  1=1, KMOO 

BRIGIT26 

1146 

IS= IN V ( I  ,  1 ) 

BRIGIT27 

1149 

IF( IS  «L£ • (KF AC* KMOO) .OK.IS.GT. (KFAC+1) 

♦KMOD) GO 

TO  80 

BRIGIT20 

1150 

L  =  l  ♦  1 

BRIGIT29 

1151 

INT ( L ) = I N V ( I , 1 ) 

BRIGIT3  0 

1152 

60  CONTINUE 

BRIGIT31 

1153 

IF(L.LT.NN) GO  TO  20 

BRIGIT32 

1154 

c 

COMPLETE  The  SORTING  OF  THE  ORIGINAL  GRIO 

NUMBERS. 

BRIGIT33 

1155 

CALL  SORT(INT,NN> 

8RIGIT34 

1156 

c 

DETERMINE  CORRESPONDENCE  (ICC)  BETWEEN  NORIG  ANO  INT  ARRAYS. 

BRIGIT35 

1157 

00  130  1=1, NN 

BRIGIT36 

1158 

L=INT  (I) 

BRIGIT37 

1159 

LOC=L -1 

BRIGIT36 

1160 

110  LOC=MOO(LOC,KMOO) ♦! 

BRIGIT39 

1161 

120  IF(INV(LOC,l) .NE.L)  GO  TO  110 

BRIGIT40 

1162 

M= I NV  (LOC , 2 ) 

BRIGIT41 

1163 

ICC  ( M )  =  I 

BRIGIT42 

1164 

130  CONTINUE 

BRIGIT43 

1165 

c 

TRANSFER  INT  ARRAY  TO  NORIG  ARRAY. 

BRIGIT44 

1166 

00  220  1=1, NN 

BRIGIT45 

1167 

220  N0RIG(I)=INT(I) 

BRIGIT46 

1168 

c 

CHANGE  IG  MATRIX  ACCORDING  TO  CORRESPONDENCE  TABLE 

ICC. 

BRIGIT47 

1169 

CALL  SWITCH (IG, III , INT, ICC,IP(1) ,IP (HAXDEG+1 ) ) 

BRIGIT46 

1170 

REWINO  6 

BRIGIT49 

1171 

RETURN 

BRIGIT50 

1172 

END 

BRIGIT51 

1173 

SUBROUTINE  SORT (LIST , NL ) 

SORT  2 

1174 

c 

THIS  SUBROUTINE  SORTS  A  LIST  OF  LENGTH  NL 

ANO  IS  BIASED  TOWARDS  THOSE 

SORT  3 

1175 

c 

LISTS  NOT  BADLY  OUT  OF  SORT. 

SORT  4 

1176 

OIMENSION  LIST ( 1 ) 

SORT  5 

1177 

IF(NL.LE.l)  RETURN 

SORT  6 

1178 

NL 1=NL-1 

SORT  7 

1179 

□0  20  1=1, NL1 

SORT  a 

1160 

K=NL-I 

SORT  9 

1161 

KFLAG=0 

SORT  10 

1162 

00  10  J= 1 , K 

SORT  11 

1183 

IF (LI ST (J) .LE.LIST (J+l) )  GO  TO  10 

SORT  12 

1184 

KFLAG=1 

SORT  13 

1185 

L*L 1ST ( J) 

SORT  14 

1166 

LIST(J)=LIST(J+1) 

SORT  15 

1187 

LIST < J+l >=L 

SORT  16 

1168 

10  CONTINUE 

SORT  17 

1169 

IF(KFLAG.EQ.O)  RETURN 

SORT  18 

1190 

20  CONTINUE 

SORT  19 

1191 

RETURN 

SORT  20 

1192 

ENO 

SORT  21 

1193 

SUBROUTINE  SETIG (KG1, KG2, IG, III, NORIG) 

SETIG  2 

1194 

c 

THIS  ROUTINE  SETS  IG (KG1, -) =KG2  AND  IG(KG2 

,  - )  *  kg  i  : 

IF  THIS 

SETIG  3 

1195 

c 

connection  has  not  already  been  set. 

SETIG  4 

1196 

OIMENSION  IG(II1,1) , NORIG (1) 

SETIG  5 

1197 

COMMON  /S/  NN, MM, IH, 13 

SETIG  6 

1196 

COMMON  /A/  MAXGRO, MAXOEG, KMOO, NMPC 

SETIG  7 

1199 

COMMON  /BITS/  N3IT IN, NB ITEX , IPASS 

SETIG  8 

1200 

59 


IF  (KG1.EQ.0) RETURN 

SETIG  9 

1201 

IF(KG2.EQ. 0) RETURN 

SETIG  10 

1202 

IF  (KG1.EQ.KG2)RE  TURN 

SETIG  11 

1203 

00  50  LOOP= 1 »  2 

SETIG  12 

1204 

L  =  KG1 

SETIG  13 

1205 

K*  KG2 

SETIG  14 

1206 

IF  (LOOP*  EOl*  1)  GO  TO  20 

SETIG  15 

1207 

L*KG? 

SETIG  16 

1208 

K*KG1 

SETIG  17 

1209 

20  M=  0 

SETIG  18 

1210 

30  M  =  M  + 1 

SETIG  19 

1211 

IF (M.GT.MAXOEG)  GO  TO  60 

SETIG  20 

1212 

IS  *  IG(L,M> 

JJ  24 

1213 

IF ( IS . t  Q . 0 )  GO  TO  40 

SETIG  22 

1214 

IF(IS.NE.K)  GO  TO  30 

SETIG  23 

1215 

GO  TO  50 

SETIG  24 

1216 

40  IG  <  L  ,  M)  =  K 

JJ  25 

1217 

MM  =  MA  X  0  (  MM,  Ml 

SETIG  2 o 

1218 

50  CONTINUE 

SETIG  27 

1219 

RETURN 

SETIG  28 

1220 

60  WRI TE (6  »  7 0 )  NJRIG(L) , MAXOEG 

SETIG  29 

1221 

70  FORMAT ( 12H1  GRIU  POINT , I 12 , 26M  HAS 

DE  G  RE  E 

GREATER  THAN, 16/ 

SETIG  30 

1222 

14H  FATAL  ERROR.  ) 

SETIG  31 

1223 

CALL  BOMdlT(b) 

SETIG  32 

1224 

END 

SETIG  33 

1225 

SUBROUTINE  T I GER ( NEU , IG , 1 1 1 , L I  ST , NOR IG ) 

TIGER  2 

1226 

C  THIS  ROUTINE  MAKES  ADDITIONS  TO  THE  CONNECTION  TABLE  IG  TO  REFLECT 

TIGER  3 

1227 

C  THE  PRESENCE  OF  MPC'S  ANO  STORES  T  Ht 

OEPtNOtNT  POINTS  In  LIST. 

TIGER  4 

1228 

C  NE  Q=  NUMBE  R  OF  HPC  EQUATIONS. 

TIGER  5 

1229 

DIMENSION  IG(IIlvi) » L  I S  T  ( 1 ) »  NOR I 6 ( 1 ) 

tiger  6 

123  u 

COMMON  /S/  NN , MM , I H, I 9 

TIGER  7 

1231 

COMMON  /A/  HAXGRD, MAX DEG , KMOO , NMPC 

TIGER  8 

1232 

COHMON  /JITS/  NiJITlN,  NQITEX,  IPASS 

TIGER  9 

1233 

DIMENSION  KG ( 40 ) 

TIGER  10 

1234 

IF (NEQ.tQ.O) RETURN 

TIGER  11 

1235 

REMIND  11 

TIGER  12 

123b 

C  I N IT IAL IZt  LIST  . 

TIGER  13 

1237 

DO  20  1=1, NN 

TIGER  14 

1238 

20  LIST (  I>  =0 

TIGER  15 

1239 

C  GENERATE  NEW  CONNECTIONS. 

TIuER  lo 

1240 

OO  100  11=1, NEU 

TIGER  17 

1241 

READ! 11) Kj 

TIGER  18 

1242 

IGR IO=KG ( 1 ) 

TIGER  19 

1243 

LIST! IGRIJ) =IGRID 

TIGER  20 

124h 

OO  100  1=1, MAXOEG 

TIGER  21 

1245 

L  =  I  G ( I  SRI U,  I ) 

JJ  26 

124b 

OO  too  J  =2 , NMPC 

TIGER  23 

1247 

100  CALL  SETIG(L,KG(J> ,IG, III, NORIG) 

T  IGER  24 

1248 

REWIND  11 

TIGER  2a 

1249 

RETURN 

TIGER  2b 

1250 

END 

TIGER  27 

1251 

subroutine  Switch( ig,  m, iflag, kt,ka, 

KB) 

SWITCH  2 

1252 

C  THIS  SUBROUT  1 NL  GENERATES  A  NEW  IG  MATRIX 

ACCORDING  TO  THE 

SWITCH  3 

1253 

C  CORRESPONUtNCE  TADLE  KT,  WHICH  MUST 

Ui- 

SET 

UP 

SWITCH  4 

1254 

C  PRIOR  TO  THE  CALL.  ONLY  INTERNAL 

NUMBERS 

ARE  ALLOWED 

SWITCH  5 

125a 

C  AS  VALUES  OF  KT. 

SWITCH  6 

125o 

C 

SWITCH  7 

1257 

C  INPUT  -  IG,KT 

SWITCH  8 

1268 

C  OUTPUT  -  IG 

SWITCH  9 

1259 

C  SCRATCH  -  IFLAG  ,KA, K3 

SWI TCH10 

I2b0 

c 

SHITCH11 

I2bl 

OIMENSIUN  IG(IIlfi) , I FL  AG ( 1 > , K  T ( 1 )  ,  < A ( 1 J 

,  KB  (  1) 

SWITCH12 

12b2 

COMMON  /S/  NN , MM , I H, I 3 

SWITCH13 

12b  3 

COMMON  /A/  MAXGROjMAXDEG, KMOO, NMPC 

SWITOH14 

12b4 

COMMON  /BITS/  Ndi T IN, Nd I  TEX , IPASS 

SHlTCHla 

1  2o5 

C  KT=CORRESPUNOcNCE  TAdLt.  KT(OLO)  =  NEW. 

SHlTCHlo 

1 2bu 

c  ka,kb  =  temporary  storage  rows. 

SWITCH17 

1267 

OO  10 J  I = 1 , NN 

SWITCHld 

1268 

OO  90  J= 1 , M M 

SWITCH19 

12b9 

L  =  I  G  ( I  ,  J) 

JJ  27 

12  7V 

IF(L.LE.Q)  GO  TO  103 

SWITCH21 

1271 

IS=KT CL) 

SHITCH22 

1272 

IG  ( I ,  J)  =  IS 

JJ  28 

1273 

90  CONTINUE 

5WITCH2** 

1274 

100  CONTINUE 

SWITCH2S 

127a 

C  INIT IAL IZE  FLAG j. 

owl TCH2o 

12  7o 

UO  120  1=1, NN 

SW I T CH2  7 

1277 

120  IFL AG  ( I ) =0 

swUCHza 

127  s 

c  initialize  temporary  storage  rohs. 

SWITCH29 

1279 

UO  130  1=1, MM 

.iWiTCHJa 

1280 

KA(I) =0 

SWITCH31 

1281 

130  KDU>=0 

a Wl TCH32 

1282 

C  RE-OROER  ROW  >  OF  IG  MATRIX. 

SWITCH33 

1283 

OO  20J  I  ROW  =  1 , NN 

S  wl T  OH3h 

1264 

IFC IFlAGC IROW) .cQ.D  G3  TO  200 

3WITCH35 

128a 

IF (KT (IROW) . tQ. IRON)  GO  TO  200 

SWITCH3o 

1 2  8  o 

IFLAG (IROW) =1 

SWITCH37 

1287 

DO  140  J  =  1 , MM 

SHITCH33 

1288 

140  K3(J)  =  IG ( IRJW , J) 

JJ  2  9 

12  d  9 

L  =  KT(  IROW) 

S HI T  CH40 

•  1290 

150  IFLAG(L)=1 

SWITCH41 

1291 

OO  16  J  J  =  1 , M  M 

SWITCH42 

1292 

KA ( J )  =  IG ( L  ,  J ) 

JJ  3  U 

1293 

IG  ( L ,  J)  =  K  3  (  J ) 

JJ  31 

1294 

160  KB ( J ) =K A  ( J ) 

SWITCHES 

1295 

M=KT(L) 

S  Wl  T  CHh  n» 

129o 

IF  ( IF  LAG  (  M )  .cu.l)  uU  TO  170 

SWITCH47 

1297 

L  =  M 

SWITCH48 

1298 

GO  TO  150 

S Wl T  CH4  9 

i29y 

170  OO  180  J  =  1 , MM 

SW I T  CH5  j 

1300 

60 


iaa  ig<m,j)  *  kb ( j ) 

JJ  32 

1301 

200  CONTINUE 

SHITCH52 

1302 

RETURN 

SHITCH53 

1303 

END 

SHITCH54 

13  U  4 

SUBROUTINE  MORRIS (L IS T, NL, IG,IIi) 

MORRIS  2 

1305 

C  THIS  ROUTINE  DELETES  ALL  REFERENCE  IN  THE 

CONNECTION  TABLE 

IG 

MORRIS  3 

1306 

c  to  those  point*  in  a  list  of  length 

NL. 

MORRIS  4 

130  7 

DIMENSION  IG(IIl,l),lIST (1) 

MORRIS  5 

1306 

COMMON  /S/  NN»MH 

MORRIS  6 

1309 

COMMON  /A/  MAXGRD 

MORRIS  7 

1310 

COMMON  /9 ITS/  NBITIN, NBITEX 

MORRIS  d 

1311 

C  COMPRESS  OUT  DUPLICATE  ENTRIES  IN  LIST. 

MORRIS  9 

1312 

CALL  FIX  IT (LIST , NL ) 

HORKISIO 

1313 

IF(NL.LE.d)  RETURN 

MORKIS11 

1314 

MM1 *MM-1 

M0KRIS12 

1315 

DO  60  IJ*1,NL 

MORRlSli 

1316 

I=L  1ST  <  I J  > 

M0RRIS14 

1317 

DO  50  J* 1 » MM 

MORRIS15 

1318 

L*IG( It J) 

JJ  33 

1319 

IFU.EQ.OI  GO  To  6U 

MORRIS!/ 

1320 

K*0 

M0KKIS18 

1321 

20  K =K ♦ 1 

MORRIS19 

1322 

M*  I  G  <  L  ,  K) 

JJ  34 

1323 

IF ( H. NE « II  GO  TO  20 

MORRIS21 

1324 

IF (K.GE.MM)  GO  TO  40 

M0RRIS22 

1325 

00  30  N  =  K»  MHl 

HORRIS23 

132o 

IS=IG (L, N+l) 

JJ  35 

1327 

30  IG  (L » N)  s  IS 

JJ  36 

1326 

40  IG  ( Li  MM>  =  0 

JJ  37 

1329 

1G  (I,J>  *  U 

JJ  36 

1330 

50  CONTINUE 

M0KRIS28 

1331 

60  CONTINUE 

MORRIS29 

1332 

RETURN 

M0RRIS3J 

1333 

END 

MOKRISJ1 

1334 

SUBROUTINE  FI XI T (L 1ST , NL ) 

FIXIT  2 

1335 

C  THIS  ROUTINt  COMPRESSES  OUT  ZEROES  AND  MULTIPLE 

ENTRIES  IN 

A  LIST 

FIXIT  3 

l33o 

C  ORIGINALLY  OF  LENGTH  NL .  .A  CORRECTED 

LENGTH 

NL  IS  RETURNED  TO 

FIXIT  4 

1337 

c  the  CALLING  PROGRAM. 

FIXIT  5 

1338 

DIMENSION  LIST ( 1 ) 

FIXIT  6 

1339 

IF(NL.LE.O)  RETURN 

FfxiT  7 

1340 

IF(NL.EQ.l)  GO  To  110 

FIXIT  d 

1341 

nli=nl-i 

FIXIT  9 

1342 

C  OELETE  DUPLICATE  ENTRIES. 

FIXIT  10 

1343 

DO  20  1=1, NL1 

FIXIT  11 

1344 

IF  < LIST { I) • EQ. 0 )  GO  TO  20 

FIXIT  12 

1345 

I1=I*1 

FIXIT  13 

134b 

00  10  J- 11 , NL 

FIXIT  14 

1347 

IF(LIST(I).N£.LIST(J) )  GO  TO  10 

FIXIT  15 

1348 

LIST  C I)  =  0 

FIXIT  16 

1349 

GO  TO  20 

FIXIT  17 

1350 

10  CONTINUE 

FIXIT  18 

13*1 

20  CONTINUE 

FIXIT  19 

13  -2 

c  delete  zeroes. 

FIXIT  20 

1353 

00  40  1=1, NL1 

FIXIT  21 

1354 

K=  0 

FIXIT  22 

1355 

25  IF ( LI  ST ( I > • Nl • 0 )  bO  TO  40 

FIXIT  23 

135o 

K=K*1 

FIXIT  24 

135/ 

DO  30  J=I,NL1 

FIXIT  25 

1358 

30  LIST ( Jl  =  LIS  T ( J+1J 

FIXIT  2o 

1359 

LIST(NL) =0 

FIXIT  27 

13.6  0 

IF ( K . Gt • ( NL- I ♦ 1 ) )  GO  TO  7) 

FIXIT  28 

1361 

GO  TO  25 

FIXIT  29 

1362 

40  CONTINUE 

FIXIT  30 

1363 

C  CALCULATE  NtH  Lt*GTh  NL. 

FIXIT  31 

13b4 

70  00  SO  1=1, NL  . 

FIXIT  32 

136a 

J=NL-I+1 

FIXIT  33 

1363 

IF(LIST(J) .Nc.O)  GO  To  90 

FIXIT  34 

1367 

90  CONTINUE 

FIXIT  35 

1368 

90  NL=NL-I*1 

FIXIT  3b 

1369 

return 

FIXIT  37 

137  0 

110  IF (LIST (1) . t Q. 0 )  NL  =0 

FIXIT  3d 

1371 

RETURN 

FIXIT  39 

1372 

ENO 

FIXIT  40 

1373 

SUBROUTINE  SCHEME  (  NT  ,J4UH , NON ,10,  IP,  IG 

,II1,IC 

, IDES, I DIS) 

,IW, 

SCHEME  2 

1374 

♦  NEW, ICC,ILJ,IPP) 

SCHEME  3 

1375 

C  10  IS  VALIO  IFF  2.LE.I0.LE.3 

SCHEME  * 

1376 

DIMENSION  I G ( I I 1 , 1 ) , I C ( 1 ) , IDEG ( 1 ) , I J I S ( 1 ) , IH (11 

SCHEME  5 

1377 

DIMENSION  NEH(l) , ICC ( 1 >  , ILO ( 1 )  ,  I PP< 1 ) 

SCHtME  6 

1378 

C  IPP  HAS  DIMENSION  2*.1AX0EG 

SCHEME  7 

1379 

COMMON  /S/  NN,MH,IH,I3 

SCHEME  a 

I3d0 

COMMON  /P/  IHd.IHE 

SCHEME  9 

1381 

COMMON  /A/  MAXi.RO 

SCHEME1J 

1382 

COMMON  /C/  iNAKN, LINE, KORIG, KNEW 

SCHEME11 

138  3 

COMMON  /BITS/  NJlTlN, Nd IT£X, IPASS 

3CHEME12 

138h 

COMMON  /TIME/  ST IME , NCM 

SCHEME13 

1385 

COMMON  /J/  IPARAM(20) 

SCHEME14 

138  u 

COMMON  / 90L/  ISTART ( 130 >, IGNORE ( 1U 0) , 

IF  IRS  T ( 1U  0  ) 

SCHEME1 5 

1387 

COMMON  /DOLL/  IDIM , ISTA , I IG, IFIR 

SCHEME16 

1388 

DIMENSION  NOOESL(IOO) 

SCHEME17 

1389 

EQUIVALENCE  <IH,ATIM£) 

1 

SCHEME18 

139  J 

C  UETERHINE  THE  DEGREE  OF  EACH  NODE. 

SCHEME19 

1391 

CALL  DEGREE (IG, III, IOEG) 

SCHLME2U 

1392 

C  DETERMINE  MOJO,  THE  HOST  PREVALENT  NODAL 

DEGREE. 

SCHtME2 1 

1393 

MOUO  =  MOOc.  <  I  UEo  »  IPP  ) 

SCHEME22 

1394 

C  DETERMINE  THE  NUMBER  OF  COMPONENTS,  NCM. 

SCHEME23 

1395 

NCM=COMPNT (IG, III, IC, 10 EG , IH, ICC) 

SCHLME24 

1396 

C  DETERMINE  THE  MAXIMUM  DEGREE  OF  ANY  NODE. 

SCHEME25 

1397 

MAXO=MAXOvjK  (0  ,  IC,  IDES  ) 

SCHEME26 

1398 

MMsMAXO 

SCHEME27 

1399 

C  DETERUNE  Trit.  ORIGINAL  BANDWIDTH , IS . 

SCHEME28 

14U0 

61 


DO  30  1=1, NN 

SCHEHE29 

1401 

NEW ( I ) = I 

SCHEMEJO 

1402 

30  IL  D  <  I )  =  I 

SCHEME3 1 

1403 

IS=M»XBND(0, IG, III , IC , IO£G,NEH,ILD) 

SCHEME32 

1404 

KOR IG  =  I  S 

SCHEME3 J 

1405 

IH0= I H 

SCHEME34 

1406 

C  INITIALIZE  new  and  ilo  arrays. 

SCMEME35 

1407 

00  35  1=1, NN 

SCHEME36 

1408 

NEW ( I )  =  0 

SCHEHE37 

1409 

35  IL D  ( I )  =  0 

SCHEME38 

1410 

C  IF  IP  IS  NOT  EJUAL  TO  0,  THEN  PRINT  COrlPONENT 

NUMBER, DEGREE , 

SCHEME39 

1411 

C  AND  CONNECTIONS  FOR  EACH  NODE. 

SCHEME4  0 

1412 

IFdP.EG.JI  GO  TO  31 

SCHEME41 

1413 

C  PRINT  INTERNAL  NUMBER  CONNECTION  TABLE. 

SCHEME42 

1414 

00  60  1=1, NN 

SCHEME43 

1415 

IF (MOO(I,LlNE) •  E  J« 1)HRITE(6» 19) 

SCHEMES', 

1416 

19  FORMAT(3 7HlLABtL  COMP  MUIST  DEGR  CONNECTIONS  ,10X, 

SCHEME45 

1417 

1  16H(INTtKNAL  NUMBERS)  ) 

SCHEME46 

1418 

MDI ST=0 

SCHEME47 

1419 

DO  65  J=l,MAXO 

SCHEME48 

1420 

IS1  =  IG  ( I ,  J) 

JJ  39 

1421 

IF(  IS1.ES.O)GO  TO  o5 

SCHLME5U 

1422 

MDI3T=MAX0(MI)IST,IABS(I-IS1)  ) 

SCHEME51 

1423 

65  CONTINUE 

SCHEME52 

1424 

IPP(1)=IC(I) 

SCHEME53 

1425 

IPP ( 2 ) = I J£G  <  I ) 

SCHEME54 

1426 

DO  610  I  PI  =  1 , MAXO 

SCHEME55 

1427 

610  IPP  (  IP  1 4-2  )  =  I  G  ( I  ,  IP  1 ) 

JJ  40 

1428 

IS1=MAXJ*2 

SCHEME57 

1429 

60  WRITE (b,61) I, IPP(1 ) ,MDIST, ( IPP  (J) , J  =  2, IS1) 

SCHEME58 

1430 

61  FORMAT (516,2015/  25 < 2 5X , 21 15 / ) ) 

SCHEME59 

1431 

WRITE (6,700) 

SCHEME60 

1432 

7  00  FORMAT ( 1  HI , // , 32X , 31HPROGRAMME R  INFORMATION  MESSAGES  /) 

SCHEME61 

1433 

WRI  TE  (  6,  29)  I  S  ,  I H 

SCHEME62 

143  4 

29  FORMA  T ( 1 9H  ORIGINAL  8AN0WIDTH, 17 , 10H  PROFILE 

,  110) 

SCHEME63 

1435 

WRITE  (6,27)  MOUO 

SCHEME64 

143b 

27  FORMAT ( 3 OH  MODE  OF  OEGRtE  DISTRIBUTION  =,IS! 

SCHEME65 

1437 

IF( ISTA.Lt. 0)  GO  TO  31 

SCHEME66 

1438 

WRITE  (6,701) 

SCHEME67 

1439 

7  01  FORMA  T { 3AH  STARTING  MOOES  SUPPLIEO  BY  USER  -) 

SCHEME68 

1440 

WRITE  (6,  100)  <1  ST ART (I) ,1  =  1, ISTA) 

SCHEME69 

1441 

31  CONTINUE 

JJ  41 

1442 

IF(IO«tQ.3)  I S= I H 

SCHEME72 

1443 

C  GENERATE  NUMBERING  SCHEME  FOR  EACH  COMPONENT, 

NC. 

SCHEME73 

1444 

00  500  NC=1,NCM 

SCHEME  74 

1445 

c  determine  THE  range  OF  DEGREES  (MI  TO  MAD)  of  nodes  of 

INTEREST 

. SCHEME75 

1446 

MI=MINDEG(NC,IC,I0EG) 

SCHEME76 

1447 

MAD=M I 

SCHEME77 

1448 

IF(NOM)  90,87,90 

SCHEME  7 8 

1449 

90  MA=MAXDGR(NC,IC,IOEG) 

SCHEME79 

1450 

MAO=M !♦ ( (MA-MI) *NUM) /NOM 

SCHEMES!) 

1451 

C  MAKE  SURE  THAT  MAO  IS  LESS  THAN  MODO. 

SCHEME81 

1452 

MA 0  =M IN 0  (MAO ,MOOD- 1 ) 

SCHEMES  2 

1453 

MAD=MAX0 (MAO, MI) 

SCHEME63 

1454 

C  DETERMINE  BANDWIDTH  OR  SUM  CRITERION  FOR  EACH  NOOE  MEETING  SPECI- 

SCHEME84 

1455 

C  FIEU  CONDITION. 

SCHEME85 

1456 

87  IF(IP.EQ.O)  GO  TO  91 

SCHEMEB6 

1457 

WRITE ( 6 , 162 )  NC 

SCHEME8  7 

1458 

162  FORMAT ( 2  2H  *******  COMPONENT , 15 , 12H 

SCHEHE88 

1459 

IF(I0.tQ.2)  WRI T  E ( 6, 1 69 ) 

SCHEME89 

1460 

169  FORMAT ( 4 3H  OPTION  2  SELECTEO  (CRITERION  -  BANDWIDTH  , 

SCHEME90 

1461 

♦  57HMINIMIZATION;  CONDITION  -  MINMAX  NUMBER 

OF  NODES/1. EV  EL  )  ) 

SCHEME91 

1462 

IF(I0.Ea.3)  WRITE(6,179) 

SCHEME92 

1463 

179  FORHA  T ( 52H  OPTION  3  SELECTED  (CRITERION  -  MINIMIZATION  OF 

sum;, 

SCHEME93 

1464 

♦-  44H  CONDITION  -  MINMAX  NUMBER  OF  NODES/LEVEL)  ) 

SCHEME94 

1465 

91  CALL  OIAM(NC, MAD, NL, NODESL, MAXLEV,IG, III, IC,IDEG,IDIS,IW, 

ICC) 

SCHEME95 

1466 

IF  (IP.EU.O)  GO  TO  67 

SCHEME9b 

1467 

WRITE (6,39)  NC , MAD 

SCHEME97 

1468 

WRITE  (6,59)  MAXLEV 

SCHEME98 

1469 

WRITE (6,100)  (NOUESL(J) , J= 1 , NL) 

SCHLME99 

1470 

67  CONTINUE 

SCHEM100 

1471 

IF(ISTA.LE.O)  GO  TO  760 

SCHEH10 1 

1472 

M=  0 

SCHEM102 

1473 

00  750  1=1, ISTA 

SCHEM103 

1474 

J=ISTART (I) 

SCHEM104 

1475 

IF ( IC ( J) .NE .NC)  GO  TO  750 

SCHEM105 

1476 

M=  M  ♦  1 

SCHEM106 

1477 

DO  755  K=1 , 99 

SCHEM10  7 

1478 

L= 1 01 -K 

SCMEM10S 

1479 

755  NODESL(L) =NODESL (L-l) 

SCHEM109 

1480 

NODESL (1) =J 

SCHEM110 

1481 

750  CONTINUE 

SCHEHlli 

1482 

NL=MIN0 (NLfM, 100) 

SCHEM112 

1483 

CALL  FIXIT (NODESL, NL) 

SCHEM113 

1484 

760  CONTINUE 

SCHEM 1 1 4 

1485 

IF  (IP.EQ.O)  GO  TO  63 

SCHEM115 

1486 

IF(ISTA.LE.O)  GO  TO  63 

SCHEH116 

1487 

WRITE (6, 730) 

SCHEM117 

1488 

730  FORMAT  ( 4  8H  MERGED  LIST  OF  STARTING  NODES  SUPPLIED  BT  USER 

t 

SCHEM118 

1489 

*  1 5H AND  BY  BANOIT  -) 

SCHEM119 

1490 

WRITE (6, 10  0 )  ( NODESL ( I ) , 1= 1, NL ) 

SCHEM120 

1491 

39  FORMAT ( 1  OH  COMPONENT , 15 , 19H  MAX  OEGREE  USED, 

15) 

SCHEM121 

1492 

59  FORMA  T ( 52H  STARTING  NODES  FOR  MINMAX  NUMBER  OF 

NODES  PER  LtVEL, I5)SCMEM122 

1493 

100  FORMAT (4X,20I5) 

SCMEM123 

1494 

63  CONTINUE 

SCHEM124 

1495 

JMAX=MINO(NT,NL) 

SCHEM125 

1496 

IM= 900000000 

SCHEM126 

1497 

IMM=I M 

SCHEM127 

1498 

DO  400  J=1,JMAX 

SCHEM128 

1499 

CALL  RELABL ( 1 , NODESL ( J  )  ,  IG, II 1, IC, IDEG  ,  ID  IS ,IW 

, NEW, ICC, ILO) 

SCHEM129 

1500 

62 


IB=MAXbNJ{NC,IG,IIl,IC, IOEG, NEW, ILO) 

SCHEN130 

1501 

IF(IP.NE.Q)  WRITE(6,69)  NODESL ( J > , IB , 

IH 

>SCHEM 131 

1502 

69  FORMA  T  < 14H  iTAKUrfS  NOOc » 1 6. 4* ,9NbAMOMIOTH , lb, 3 X . FMPROF ILEi  Id) 

SCHEM132  ' 

1503 

IFdO.tQ.3)  I 0= I H 

SCHEMiSi 

r  1504 

IE*ICC(NC«-1)-1 

SCHEM1'34  * 

1505 

IFCIM-Ib)  400,350,300 

SCHEMl 35 

150b 

300  IH-IB 

SCHEM136 

1507 

IMH*IH 

SCHEM137-  r  ‘ 

1508 

IJ*J 

SCHEM138  1 

1509 

GO  TO  400 

SCHEH139  ’ 

1510 

350  IF(IMM.LE.IH)  GO  TO  400 

SCHEM14U 

1511 

INM-IH 

1  \  .  •  J 

SCHEM141 

1512 

I  J  =  J 

SCHEM142 

1513 

<*00  CONTINUE 

SCHEM143 

1514 

CALL  RELAdL ( 1 , N Q OE Sl  C I J ) , 16, III i IC, ICES , IOIS 

,IW, NEW, ICC, ILO) 

SCHEM144 

1515 

500  CONTINUE 

SCHEN145 

1516 

CALL  STACK(IDEG,NtW,lLO,IW) 

SCHEM146 

1517 

I8=MAXBND (0,IG,II1,IC, IOEG , NEW , ILO) 

.< 

SCHEM147 

1518 

IFdP.Ej.d)  GO  TO  710 

SCHEM146 

1519 

WRITE<6, 705) 

SCHEM149 

1520 

705  FORMAT(21HO  ORIGINAL  LA  9 tL ING  -) 

‘  SCHEM150 

1521 

WRITE  (6, 708)  <ORIG,IHO 

:  •  v  i  ■ 

:  SCMEM151  ' 

1522 

WRITE  <b»  707) 

' SCHEM152 

1523 

707  FORHATI21H  STU  CH  RELABELING  -) 

SCMEM153 

1524 

WRITE ( 6  » 708)  IB.IH 

SCMEH154' 

1525 

708  FORMAT UH#,2bX , 9HJAN JW I OTH , 17, 10 X,7H PRO FILE, 

110) 

‘  SCHEM155- 

1526 

709  FORMA  T ( 21H  REV  CM  RELABELING  -) 

SCMEMi5o  ' 

1527 

710  IF ( 10  •  EQ . 3)  IB=  IH 

SCHEM157s  ' 

1528 

C 

PROFILE  *  SUM  CRIT 

-  '  ■  • 

SCHEM158 

1529 

C 

IS  =  ORIGINAL  JAN JW I U TVl  (OR  SUM  CRIT  IF  10. 

EQ.  3) 

SCHEM15^‘  ■ 

153  0 

C 

I8  =  CURREN  T  BANDWIDTH  (OR  SUM  CRIT  IF  I0.EQ.3) 

SCHEMlbO 

1531 

C 

IM=CURRENT  PROFlLEt  IHO=ORIGINAL  PROFILE 

S CHE Ml 61 

1532 

IF(IB-IS)  715,742,744 

SCHEM162 

1533 

7 42  IFdri.LT.lHO)  GO  TO  715 

SCHEM163 

1534 

744  DO  712  1=1, NN 

5CHEH164 

1535 

IL0(I)=I 

SCHEH165 

1536 

712  NE H (I )  =  I 

=>'•:**  ••  •'  •  •  '* v 

SCHEM166 

1537 

CALL  STACK(Il)cG,N£W,lLO,lW) 

SCHEM167 

1538 

18=  IS 

■  •  • 

SCHEM168 

1539 

IHsIHO 

SCHEM169 

1540 

IFdP.EQ.OI  GO  TO  715 

•  •  >' 

SCHEH170 

1541 

WRITE (6, 713) 

SCHEM171 

1542 

713  FORMA  T  <  21H  ORIG  CM  RELABELING  -) 

SCHEM172 

1543 

WRITE (b, 708)  I B , IH 

SCMEM173 

1544 

715  IHE=IH 

SCh£mi74 

1545 

CALL  REVERS(NEW,IL0) 

SCHEM175 

1546 

I8=MAXbND(0,IG, III, IC, IOEG, NEW, 1LD) 

SCHEM176 

1547 

IF  ( IP .EU.J)  GO  TO  717 

SCHEM177 

1548 

WRITE (6,709) 

SCHEM178 

1549 

WRITE  (6, 708)  IU, IH 

SCHEM  i.79': 

1550 

717  IFdH.LT.IHt)  GO  TO  720 

SCHEM18U 

1551 

CALL  RE VERS ( NEW, ILU) 

SCHEM181 

1552 

IB=MAX6NO(0 , IG, III , IC, IOEG, NEW, ILD) 

SCHEM182 

1553 

720  IHE=IH 

SCHEM183 

1554 

KNE  W= IB 

SCHEM184 

1555 

IF(IP.EQ.O)  GO  TO  508 

SCHEM185 

1556 

WRITE  (6,722) 

:  ‘SCHEM186 

1557 

722  FORMA  T ( 2 IH  ••  FINAL  LABELING  -) 

■  ■ 

SCHEM187 

1558 

WRI TE (6,708)  KNE W , IHE 

!  scHfeMiaa 

1559 

503  CONTINUE 

jj:  42 

15oQ 

600  RETURN 

SCHEM194  ' 

1561 

END 

SCHEM195 

1562 

subroutine  stack (IOEG, NEW, ILU,IW) 

•'  •  .  >  •  ( 

STACK  2 

1563 

C 

STACK  POINTS  OF  ZERO  JEGREE  AT  END  OF  THE 

NUMBERING i 

‘  '  STACK ; -  3 

1564 

DIMENSION  Il)EG(l),NEW(l),ILD(l),lH(l) 

STACK  4 

1565 

C 

IW  IS  SCRATCH  STORAGE. 

'STACK  ■  5  • 

1566 

COMMON  7S7  NN 

•  ' '  "  *  •  r 

STACK  6 

1567 

COMMON  /ZERO/  KT 

STACK  7 

156  8 

KT  =  0 

STACK  8 

1569 

NN1=NN-1 

STACK 

1570 

c 

LIST  POINTS  OF  ZERO  OEGREE  AND  INCREMENT 

COUNTER 

KT. 

STACK  10 

1571 

00  10  1=1, NN 

STACK  'tV  '  '' 

1572 

IF ( IDEG ( I) • 6  T. 0 )  GO  TO  10 

STACK  12 

1573 

KT=  KT ♦  ! 

STACK  13 

1574 

IW(KT)  =  ILJ(D 

STACK  14 

1575 

10  CONTINUE 

STACK  15 

1576 

IF(KT.LE.U)  GO  TO  70 

StACK  lb 

1577 

c 

SORT  LIST  OF  RENJMBERED  NUMBERS  TO  BE  STACKED. 

STACK  17 

1578 

CALL  SORT (IW,KT) 

STACK  18 

1579 

c 

STACK  POINTS  OF  ZERO  DEGREE  AT  END  OF  NEW 

. 

STACK  19 

1580 

DO  40  L=1,KT 

STACK  20 

1581 

1  =  I W <  L) -L*l 

STACK  21 

1582 

K=NEW  (I) 

STACK  22 

1583 

IF (I • GE . NN)  GO  TO  30 

STACK  23 

158,4 

DO  20  J= I , NN1 

STACK  24 

1585 

20  NEW(J)=NEW( J+l) 

STACK  25 

1566 

30  NEW (NN) =K 

STACK  26 

1587 

40  CONTINUE 

STACK  27 

1568 

c 

CORRECT  ILO,  THE  INVERSE  OF  NEW. 

STACK  28 

1569 

70  00  80  1=1, NN 

STACK  29 

1590 

K=NEW  <1 ) 

STACK  30 

1591 

80  ILD (K ) = I 

STACK  31 

1592 

RETURN 

STACK  32 

1593 

END 

:  STAdk  33 

1594 

SUBROUTINE  REVt RS ( NEW , ILD) 

REVERS  2 

1595 

c 

REVERSE  THE  NUMBERING  OF  THE  FIRST  NN-KT 

GRIO  POINTS. 

REVERS  3  ";!V- 

1596 

c 

NN=NUMBER  OF  GRID  POINTS. 

REVERS  4 

1597 

c 

KTsTHE  NUMBER  OF  POINTS  OF  ZERO  DEGREE  (STACKED 

AT  END  OF  NEW 

REVERS  5 

1596 

c 

BY  STACK) 

REVERS  6 

1599 

DIMENSION  NEW (1) , ILD( 1 ) 

REVERS  7 

1600 

S3 


COMMON  /$/  NN 

REVERS  8 

1601 

COMMON  /ZfcRO/ 

RtVERi  9 

1602 

C  REVERSE  NEW  ARRAY ♦ 

REVERS10 

16  Q  3 

J«(NN-KTI/Z 

REVERS 1 1 

1604 

LL»MN-KT ♦  ! 

REV ERS12 

16U  5 

oo  10  m»j 

REVERS1 3 

1606 

L-U-I 

REVERS14 

1607 

K*NEM(ll 

KEVERS15 

1608 

NEMa>*NEH(I> 

REVERS16 

1609 

10  NElKDvK 

REVERS17 

lblU 

L  COR*£C'  I  tO,  Trtt  INVERSE  OF  NEW, 

KEVERS18 

1611 

00  20  <*1,NN 

REVERS19 

1612 

K«NEH  (I) 

REVERS2  0 

1613 

21)  IL  D  ( K  1  *  I 

REVERS21 

1614 

RETURN 

REVERS22 

1615 

ENO 

REVERS 23 

1616 

subroutine  oegree<ig,  iu,  iufg> 

DEGREE  2 

161  7 

C  SET  UP  THE  I3EG  ARRAY  CONTAINING  THE  DEGREE  OF  EACH  NODE  STORED 

DEGREE  3 

161  8 

C  IN  THE  IQ  ARRAY, 

DEGREE  4 

1619 

C  I3EGU> -DEGREE  OF  NODE  l 

DEGREE  5 

1620 

DIMENSION  lu  « IU»H  ,  lUEG(l) 

DEGREE  6 

1621 

COMMON  (%t  NN,MM,lH,Id 

DEGREE  7 

1622 

COMMON  /A/  MA#GRO 

degree  a 

1623 

COMMON  /BITS/  NaiTIN,NQITEX, IPASS 

DEGREE  9 

1624 

00  10  0  X«1|NN 

DEGREEl 0 

1625 

IDEG(  IUJ 

DtGREEl 1 

1626 

00  50  J«l,MM 

0EGREE12 

1627 

IF(XG(I,U>)  100,100,50 

JJ  43 

1623 

50  XdEbtlJ  *lDtb(  I)  *1 

ULGRcEl** 

1629 

60  CONTINUE 

0EGREE15 

1630 

li)0  continue 

OEGREE 16 

1631 

RETURN 

DEGREEl/ 

1  b32 

ENp 

DtGREEia 

1633 

FUNCTION  MUUl CIOEG.MOJJ) 

MODE  2 

1634 

C  COMPUTE  MODE,  1  HE  MOST  PREVALENT  NODAL  DEGREE •  IF  SEVERAL  Ut&RtuS 

MODE  3 

1  b3  5 

C  ARE  EOUAlLY  PREVALENT,  THE  LOWEST  IS  CHOSEN. 

MODE  4 

1636 

COMMON  tit  NN , MM 

MODE  5 

1637 

QIMEN.>I0  i  I  JtGIl)  ,MOOO(D 

MODE  o 

1638 

C  I OEG ( I ) -OEuKuc  OP  NODE  I 

MODE  7 

1639 

p  MDUU(I)  =  RUM  UK  OF  NOJ_S  OF  DEGREE 

I 

MODE  8 

1640 

00  10  1  =  1,  M.M 

MODE  9 

1641 

10  MOIjO  <  I )  3  i) 

MODt  10 

1642 

DO  20  I*l*M 

M OOE  11 

1643 

KsIOEG(I) 

MODE  12 

16*44 

20  MQUl>U)*MUl.U<K>U 

MODE  13 

1645 

MODE  =  0 

MODE  14 

lb4  6 

MAXsO 

MODE  15 

1047 

UO  3U  |=1, MM 

MODE  16 

lo4tt 

KsMOD J< I ) 

MODE  17 

1649 

IF (K.Lw, MAXI  GO  TO  30 

MODE  18 

1650 

MAX  =  K 

MODE  19 

16sl 

MODE-! 

MODE  20 

1652 

30  CONTINUE 

MOOfc  21 

lbi>3 

return 

MODE  22 

lbb4 

ENU 

MODE  23 

1655 

FUNCTION  CU.1HN1  UG,i{  1,  IC.IOkG 

,iw,icc> 

COMPNT  2 

165b 

C  TrI>  FUNCTION  HAS  AS  ITS  V4LU£  TH£ 

NUMBER  JF  COMPONENTS 

STORED 

COMPNT  3 

1657 

C  IN  THE  CONNECTION  ARRAY  JG. 

CUMPNT  4 

1 6t>8 

C  AL5D,  IC  AND  ICG  ARE  SE1  JP. 

COMPNT  5 

lb  5  9 

C  I;  (I )  sCOMPONLNT  JNUCX  FD-*  NUJt  I 

COMPNT  o 

lbbO 

C  ICC(I)=THE  starting  POSITION  TO  1 

BE  USED  FOR  LABELS  IN 

COMPONENT  I 

COMPNT  7 

lbol 

c  thus,  icc<m>-icc(m  the  number  i 

OF  NOJlS  IN  COMPONENT 

I 

.'OMPNT  8 

1662 

JIMENalOJ  Mm,tl,KUI,UI'(ll!,tillll,IOCIl) 

vOMPNT  9 

1663 

COMMON  tit  NN,MM,IH,H 

1 OMPNT 1 0 

1 6o4 

COMMON  /A/  MAXGRD 

CUMPNT 1 1 

1666 

OOHHCH  /JITS/.  N'Jl  f  IN,  MjlT;x,  IP4SS 

COMPnT 1 2 

1  6o6 

C  INITIALIZE  ARRAYS. 

COMPNT 13 

1667 

DO  10  0  1*1, NN 

COMPNT  14 

1668 

iqc  <n»o 

COMPNTl 5 

1669 

ICdMC 

COMPNT 16 

1670 

100  continue 

COMPNT  1  7 

1671 

NC=0 

COMPNUa 

1672 

ICC  U)«l 

COMPNT 19 

1673 

C  Check  if  IC  Is  COMPLtTE. 

COMPNT 2  J 

1674 

iq»  00  110  1*1, NN 

COMPNT^i 

ib7  5 

IFilCdM  110,120,110 

COMPNT22 

1676 

110  COMPN T* NO 

COMPNT  23 

1677 

RETURN 

COMPNT2>4 

lb7  3 

120  NC=NC*1 

COMPNT25 

1679 

KI  =  0 

C  UflPNT  2u 

l6o  J 

KO  =  1 

COMPNT27 

1681 

IW  < 1) *1 

COMPNT  28 

1682 

ICdJflMC 

COMPNT29 

1683 

IFCNC-ll 13|3,12?,126 

COMPN  T3 J 

1o8*4 

125  IS*  ICC  (NO  *  1 

COMPNT  3 i 

1685 

ICC  C  N C ♦ 1 > =13 

COMPNT 32 

168b 

130  Kl  =  KI ♦ 1 

COMPNT  33 

1  d  8  7 

II  =  IW  (KII 

C  OMPNT  34 

1688 

N= I DC  G( II) 

C  OMPNT  J? 

1689 

IF  (  N)  140,105, l*,'} 

COMPNTjb 

1  b  90 

14 J  UO  20  0  X  ?1 ,  N 

CUMPNT  o7 

1691 

IA  *  IG(U,I) 

J  J  -f** 

io92 

IFdCdAM  200,150,200 

COMPNT 39 

lo93 

150  Ip ( IA }*nC 

COMPNThO 

169h 

KU*KPH 

COMPNT -4  1 

ib96 

IW(K0)*JA 

COMPNT  i,2 

lo96 

I3=ICC (NCtl) *1 

COMH  n-4 3 

1697 

ICC <NC*1> =JS 

COMPNT-4H 

1698 

200  CONTINUE 

COMPNT*5 

ib99 

IF(KO-KI)  105, 10*3,130 

COMPNTho 

1  7o  0 

64 


END 

C0MPNT47 

1701 

FUNCTION  MAXUGR(NC,IC,IOEG) 

NAXOGR  2 

1702 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MAXIMUM 

DEGREE  OF 

ANY 

NODE 

OF 

MAXOGR  3 

1703 

C 

COMPONENT  NC  IF  NC.GT.O 

MAXOGR  4 

1704 

C  IF 

NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 

MAXOGR  5 

1705 

DIMENSION  IC  <  1 )  , IOEG ( 1 ) 

MAXOGR  6 

1706 

COMMON  /S/  NN,MM,IH,IB 

MAXOGR  7 

170  7, 

M*  0 

MAXOGR  8 

1706 

00  100  1*1, NN 

MAXOGR  9 

1709 

I F ( NC ) 4 0 ,50 ,40 

MAXOGRl 0 

1710 

40 

IF(IC(I)-NC)  100,50,100 

HAXUGRU 

1711 

SO 

IF ( IDEG ( I) - M)  100,100 , bQ 

MAX0GR12 

1712 

60 

M*IDEG<I) 

MAX0GK13 

1713 

100 

CONTINUE 

MAX0GR14 

1714 

MAXDGR*M 

MAX0GR15 

1715 

RETURN 

MAXOGRl 6 

1716 

END 

MAXOGR17 

1717 

FUNCTION  MAXBNO(NC,IG, II1,IC, I DEG, NEW, 

ILD) 

MAXBND  2 

1718 

c  this  function  has  as  its  value  the  haxihuh 

difference 

BElMEEN 

NUDE 

MAXBNO  3 

1719 

c 

LABELS  OF  CONNECTED  NODES  FOR  NODES  OF 

COMPONENT 

NC. 

GT.O 

MAXBND  4 

1720 

C  IF 

NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 

MAXBNO  5 

1721 

C  THE 

NODAL  RENUMBERING  DEFINED  BY  ILO  AND  NEW  MUST  BE 

SET 

UP  PRIOR 

MAXBND  6 

1722 

C 

TO  THE  FUNCTION  CALL. 

MAXBND  7 

1723 

C  COMPUTE  IH,  THE  SUM  CHIT  (PROFILE). 

MAXBND  8 

1724 

DIMENSION  IG( 111,1 ) ,IC(1) , IOEG (1),NEM(1> ,ILD(1) 

MAXBND  9 

1725 

COMMON  /S/  NN, MM, IH, I 9 

MAXBND10 

1726 

COMMON  /A/  MAXGRO 

MAXBNDi 1 

1727 

COMMON  /BITS/  N3ITIN,NBITEX, IPASS 

MAXBN012 

1728 

IH*  0 

MAXBNOl 3 

1729 

M=0 

MAXBNDI  *♦ 

1730 

DO  103  1*1, NN 

MAXBNDi 5 

1731 

MX*  0 

MAXBN016 

1732 

IA=N£ W ( I ) 

MAXBNOl 7 

1733 

IF (NC 1 40 ,5G ,40 

MAXBN018 

1734 

40 

IF ( I A . l U . 0 ) GO  TO  100 

MAXBN019 

1735 

IF (NC-IC(IA) )  100,50,100 

MAX  GND20 

1736 

50 

N* IDE  G< I  A) 

HAXBN021 

1737 

IF (N) 100,100,150 

MAXBN022 

1738 

150 

DO  90  J*  1 ,  N 

MAXBN023 

1739 

II  *  IG ( I A , J ) 

JJ  '  45 

1740 

IB=HAX(J(3,I-IL0(IIM 

MAXBND25 

1741 

IF(IB.GT.HX)  MX* IB 

MAXBN026 

1742 

90 

CONTINUE 

MAXBND27 

1743 

IF(MX.GT.M)  H=HX 

MAXBND28 

1744 

IH=IH*MX 

MAXBND29 

1745 

100 

continue 

MAXBNU3 J 

1 74o 

MAXBNU=M 

MAXBN031 

1747 

RETURN 

MAXBN032 

1748 

END 

MAXBND33 

1749 

FUNCTION  NINDEG<NC,IC,IJE3> 

MINOEG  2 

1750 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MINIMUM 

OEGREE  OF 

ANY 

NODE 

OF 

MINDEG  3 

1751 

C 

COMPONENT  NC  IF  NC.GT.O 

MINOEG  4 

1752 

C  IF 

NC.LE.O,  ALL  COMPONENTS  ARE  CONSIDERED. 

MINOEG  5 

1753 

DIMENSION  IC(1) , IOEG ( 1 ) 

MINDEG  6 

1754 

COMMON  /S/  NN,MM , IH, I B 

MINOEG  7 

1755 

M=1 00  JO 

MINDEG  8 

1756 

DO  100  1*1, NN 

MINDEG  9 

1757 

IF (NC >40, 90, 40 

MINDEG10 

1758 

40 

IF(IC(I)-NC)  100,50,100 

MINDEG11 

1759 

50 

IF (M- IOEG(I ) )  100, 100, oJ 

MINOEG12 

176U 

60 

M= IDE  G(I ) 

rf INOEG13 

1761 

100 

CONTINUE 

MINDEG14 

1762 

MINDE  G=M 

MINOEG15 

1763 

RETURN 

MIN0EG16 

1764 

ENO 

MINUEG17 

1765 

SUdROJT  IN£  UWHINU.HAXOEG.NL^OOESL.MAXLEV  , 

D I  AM  2 

1  7bo 

♦  IG,II1,IC,IJlG,IUIS,IW,ICC> 

OIAH  3 

17t>7 

C  DET 

ERMINE  NL  PARTING  POINTS  AND  STORE  IN 

NOUESL. 

DIAM  4 

176d 

DIMENSION  IG(II1,1) ,IDIS(1>,IH(1) , ICC ( 1) , IC ( 1)  ,  IDEG(1) 

OIAH  7 

1769 

COMMON  / 5/  NN , MM , I H , I 3 

OIAH  6 

1770 

COMMON  /A/  MAXGRO 

OIAH  7 

1771 

COMMON  /BITS/  NBI T  IN  ,NH  I  T£  X  ,  IP  ASS' 

OIAH  8 

1772 

DIMENSION  NOOESL ( 1 ) 

DIAM  9 

1773 

NL*  0 

DIAM  10 

1774 

MAX  LE  V* 1 0  0  0  0 

0 I AM  11 

1775 

DO  100  1=1, NN 

DIAM  12 

177b 

IF (NC-IC (I > )  100,40,100 

DIAM  13 

1777 

40 

IF(MAXUEG-IOEGd))  100,105,105 

DIAM  14 

177  d 

105 

MO=IOIST(I,ML,MAXLEV, IG  ,  1 1 1,  IC  , I  DEG  ,  ID I S  ,  I W ,  ICC  > 

DIAM  15 

1779 

IF ( MO )  115,115,56 

DIAM  lo 

1780 

5b 

IF (ML -MAXLE  V)  5  8,64, 10 J 

DIAM  1/ 

1781 

58 

MAXLE  V=HL 

DIAM  id 

1782 

NL  =  1 

DIAM  19 

1783 

NODE  S  L ( 1 ) = I 

DIAM  2  J 

1784 

GO  TO  100 

OIAH  21 

1785 

b4 

IF(NL.GE.IOQ)  GO  TO  100 

OIAH  22 

1786 

NL  =  NL  *1 

DIAM  23 

1787 

NODESL(NL)=I 

DIAM  24 

1788 

109 

CONTINUE 

DIAM  25 

1789 

110 

RETURN 

OIAM  26 

1790 

115 

ML*  1 

DIAM  27 

1791 

NODESL(l)=I 

OIAM  28 

1792 

MAXLE V=0 

OIAM  29 

1793 

RETURN 

OIAM  3d 

1794 

END 

DIAM  31 

1795 

SUBROUTINE  HELAjL(NS,NJJES,IG, III ,IC,IDEG,IUIS,IW 

, NEW, ICC) 

,ILD) 

RELA3L  2 

1796 

C  GENERATE  A  RELABELING  SCHEME  STARTING  WITH 

NS  NODES  FOR 

WHICH 

RELABL  3 

1797 

C 

LABELS  HAVE  oEEn  STJHED  IN  ARRAY  NODES. 

RELABL  4 

1798 

C  SET 

UP  ILO  AND  NEW. 

RELABL  5 

1799 

C 

ILD (OLD) =NL  H 

RELABL  6 

1800 

65 


u 

NEH(NtHI=OLO,  The  inverse  of  ho 

RELABL  7 

1801 

DIMENSION  16(111,1) , IC< 1) ,IOEG(l) , ID  IS ( 1 >  ,  IN (1 )  , NEW (1 )  , 

ICC( 1) 

RELABL  8 

1802 

DIMENSION  I L D ( 1 ) 

RELABL  9 

1803 

COMMON  /3/  NN,MM,IH,IB 

RELABL10 

1804 

INTEGER  X 

RELABLll 

1805 

COMMON  /A/  MAXGRO 

RELABL12 

1808 

COMMON  /BITS/  N6ITIN,RBITEX, IPASS 

RELABL 1 3 

1807 

DIMENSION  NODES (  1),IAJ(50) 

RELA3L14 

1806 

I=NODES(l> 

RELABL15 

1809 

ICN=IC< I ) 

RELABL16 

1810 

NT=ICC(ICN> -1 

REL  ABL 1 7 

1811 

00  50  1  =  1  , NN 

RELABLlfl 

1812 

IF ( XC ( I > -ICN>  50,40,50 

REL  ABL 1 9 

1813 

40 

I □ I S ( I) =0 

RELA3L2Q 

1814 

50 

CONTINUE 

RELABL21 

1815 

00  100  J= 1 , NS 

RELABL22 

181b 

JJ  =  NODES ( J  > 

RELABL23 

1817 

10 1 S  < JJ) =-l 

RELA9L24 

1818 

JT  =  J  +  NT 

RELA8L25 

1819 

NEW(JT) =JJ 

REL A  bL26 

1820 

100 

ILD <JJ)= JT 

RELA8L27 

1821 

KI  =  NT 

RELABL28 

1822 

KO  =  NS  *NT 

RELABL29 

1823 

LL  =  KO 

RELA8L30 

1824 

L=1 

RELA8L3  1 

1825 

J=KO 

RELABL32 

182b 

NNC=ICC( ICN ♦ 1 > - 1 

RELABL33 

1827 

130 

KI=KI*1 

RELA8L34 

1828 

IF (KI-LL) 135,132,135 

RELABL35 

1829 

132 

L  =  L  *•  1 

RELABL36 

1630 

LL  =  KOfl 

RELABL 37 

1831 

135 

II=NEH(KI> 

RELABL38 

1832 

N=IOEG( II j 

RELABL39 

1633 

IF  ( N  > 140,255,140 

RELABL40 

1834 

140 

IJ=0 

RELABL41 

1835 

DO  200  1=1, N 

RELA0L42 

163b 

IA  s  16(11,1) 

JJ  4b 

1837 

IF ( 10  IS ( I A) )  200,150,200 

RELABL44 

1638 

150 

IJ=IJ*1 

RELA8L45 

1839 

IOI S  < IA ) =L 

REL  A3L4b 

1840 

KO=KO+l 

RELABL4  7 

1841 

IA  J  ( I J )  =  I A 

RELA3L48 

1642 

iw ( i j ) = i dec ( i a ) 

REL  ABL  49 

1843 

200 

CONTINUE 

KELABL5  0 

1844 

IF  C I J  —  1 >  250 ,210,22  0 

RELABL51 

1645 

210 

J=  KO 

RELABL52 

184b 

IZ=IAJ(1> 

RtLABL53 

1847 

NEW(KO) =IZ 

RELABL54 

1848 

ILO(IZ) =<o 

RELABL55 

1849 

GO  TO  250 

RELABL56 

1850 

220 

X=0 

RELABL57 

1851 

221 

-> 

!\l 

II 

fO 

tVJ 

o 

o 

RELABL58 

1852 

IF ( IH ( I) -IW(I-I) >224,230,230 

RELABL59 

1853 

224 

CONTINUE 

RELABLbl) 

1054 

X=lH< I) 

RELABL61 

1855 

IH  ( I )  =  I H  ( I- 1) 

RELABL62 

185b 

IH ( 1-1) =X 

RELABLbJ 

1857 

225 

X=IAJ (I) 

RELA  BLb4 

1858 

IA J (I)=IAJ(I-1) 

RELA9L65 

1859 

IAJ (1-1) =X 

REL ABLbb 

1 8b  0 

230 

CONTINUE 

REL  ABLb7 

18bl 

IF(X)235,235,220 

RELABLbS 

18b2 

235 

DO  240  1=1, IJ 

REL ABLb9 

1663 

J=J  +  1 

RELABL70 

1864 

IZ=IAJ(I ) 

RELABL71 

1 8b5 

NEW ( J )= IZ 

RELABL72 

1  flbb 

ILD(IZ) = J 

RELABL73 

1067 

240 

CONTINUE 

REL ABL74 

1868 

250 

IF ( KO-NNC) 130,255,255 

RELABL75 

1  8b9 

255 

CONTINUE 

RELABL76 

1870 

RETURN 

RELABL77 

1871 

ENO 

RELABL 78 

1872 

FUNCT ION  I0IST(NS,ML,MAXLEV,IG,II1,IC,I0EG,IDIS,IH 

,  ICC) 

IDIST  2 

1873 

C  THIS  FUNCTION  HAS  AS  ITS  VALUE  THE  MAXIMUM  OISTANCE  OF 

ANY  NODE 

IDIST  3 

1874 

C 

IN  COMPONENT  IC(NS)  FROM  THE  NODE  NS. 

IDIST  4 

1075 

c  the 

DISTANCE  OF  EACH  NODE  IN  THIS  COMPONENT  IS  STORED 

IN  THE 

ARRAY 

IDIST  5 

1876 

c 

IOIS. 

IDIST  b 

1877 

C  THE 

MAXIMUM  NUMBER  OF  NODES  AT  THE  SAME  DISTANCE  FROM 

NS  IS 

I OI  ST  7 

1070 

c 

STORED  IN  ML. 

IDIST  8 

1879 

DIMENSION  IG( III, 1) , IC ( 1) flOEG(l) , I D I S ( 1 ) , IH ( 1 ) , ICC ( 1 ) 

IDIST  9 

1880 

COMMON  /S/  NN, MM , IH, I £ 

IDIST  10 

1881 

COMMON  /A/  MAXGRO 

IDIST  11 

1882 

COMMON  /BITS/  NBI T IN, NB ITEX , IP ASS 

IQIST  12 

1883 

ICN  =  IC  <  NS) 

I0IST  13 

1884 

NNC= ICC < ICN*1)-ICC(ICN) 

IOIST  14 

1885 

DO  50  1=1, NN 

IDIST  15 

1886 

IF  ( IC  ( I ) -IC (NS) )  50,40,50 

IDIST  lb 

1087 

40 

I0IS( I)=0 

IOIST  17 

1888 

50 

CONTINUE 

IDIST  18 

1689 

LL=  1 

IDIST  19 

1890 

L=  0 

IDIST  20 

1891 

KI=  0 

IOIST  21 

1892 

KO=  1 

IDIST  22 

1893 

ML  =  0 

IDIST  23 

1894 

IH (1) =NS 

IDIST  24 

1895 

IOIS ( NS) =-l 

IDIST  25 

1896 

130 

KI=  KI +1 

IDIST  2b 

1897 

IF(KI-LL) 135, 132,135 

IOIST  27 

1898 

132 

L  =  L  ♦  1 

IDIST  28 

1699 

LL=KO+l 

IDIST  29 

1900 

M 


K*KO- Kl+i 

IUIST 

30 

IF(K-Nl)  135,135,133 

IDIST 

31 

133 

ML*K 

IOIST 

32 

IF ( HL-MAXLE V)  135,135,220 

xoisr 

33 

135 

I I* I H ( < I ) 

IOIST 

34 

N*I DEG< I I) 

IDIST 

35 

IF ( N) 140,215,140 

IOIST 

36 

140 

DO  200  1*1, N 

IOIST 

37 

IA  *  IG ( II, I) 

JJ 

47 

IF  < IOIS( IA) >  200,150,200 

IOIST 

39 

150 

IOIS(IA)*l 

IOIST 

40 

KO*KO+l 

IDIST 

41 

IN (KO ) *1  A 

IOIST 

42 

200 

CONTINUE 

IOIST 

43 

IF ( KQ-NNC) 130,205,205 

IOIST 

44 

205 

IDIST-L 

IOIST 

45 

IOISt  NS) *0 

IOIST 

46 

K*KO-KI 

IOIST 

47 

IF(K-NU  206,206,207 

IOIST 

46 

207 

NL*K 

IOIST 

49 

206 

CONTINUE 

IOIST 

50 

RETURN 

IDIST 

51 

215 

L*  0 

IOIST 

52 

GO  TO  205 

IDIST 

53 

2  20 

IQI ST*1 

IOIST 

54 

RETURN 

IOIST 

55 

END 

IOIST 

56 

SUBROUTINE  RENARK(A) 

JJ 

46 

return 

JJ 

49 

END 

JJ 

50 

FUNCTION  EOF ( I > 

JJ 

51 

INTEGER  EOF 

JJ 

52 

EOF  =  0 

JJ 

53 

RETURN 

JJ 

5<« 

eno 

JJ 

55 

1901 

1902 

1903 
190  *♦ 

1905 

1906 
190  7 

1908 

1909 

1910 

1911 

1912 

1913 
191* 

1915 

1916 

1917 

1918 

1919 

1920 

1921 

1922 

1923 

1924 

1925 
192  b'1 
1927 

1926 

1929 

1930 

1931 

1932 

1933 

1934 

1935 
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